1-- CXA4005.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- 26-- OBJECTIVE: 27-- Check that the subprograms defined in package Ada.Strings.Fixed are 28-- available, and that they produce correct results. Specifically, 29-- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice, 30-- Tail, Trim, and "*". 31-- 32-- TEST DESCRIPTION: 33-- This test, when combined with tests CXA4002-4 will provide coverage 34-- of the functionality found in Ada.Strings.Fixed. 35-- This test contains many small, specific test cases, situations that 36-- although common in user environments, are often difficult to generate 37-- in large numbers in a application-based test. They represent 38-- individual usage paradigms in-the-small. 39-- 40-- 41-- CHANGE HISTORY: 42-- 06 Dec 94 SAIC ACVC 2.0 43-- 11 Apr 95 SAIC Corrected acceptance conditions of certain 44-- subtests. 45-- 06 Nov 95 SAIC Fixed bugs for ACVC 2.0.1. 46-- 22 Feb 01 PHL Check that the lower bound of the result is 1. 47-- 13 Mar 01 RLB Fixed a couple of ACATS style violations; 48-- removed pointless checks of procedures. 49-- Added checks of other functions. These changes 50-- were made to test Defect Report 8652/0049, as 51-- reflected in Technical Corrigendum 1. 52-- 53--! 54 55with Report; 56with Ada.Strings; 57with Ada.Strings.Fixed; 58with Ada.Strings.Maps; 59 60procedure CXA4005 is 61 62 type TC_Name_Holder is access String; 63 Name : TC_Name_Holder; 64 65 function TC_Check (S : String) return String is 66 begin 67 if S'First /= 1 then 68 Report.Failed ("Lower bound of result of function " & Name.all & 69 " is" & Integer'Image (S'First)); 70 end if; 71 return S; 72 end TC_Check; 73 74 procedure TC_Set_Name (N : String) is 75 begin 76 Name := new String'(N); 77 end TC_Set_Name; 78 79begin 80 81 Report.Test("CXA4005", "Check that the subprograms defined in " & 82 "package Ada.Strings.Fixed are available, " & 83 "and that they produce correct results"); 84 85 Test_Block: 86 declare 87 88 package ASF renames Ada.Strings.Fixed; 89 package Maps renames Ada.Strings.Maps; 90 91 Result_String, 92 Delete_String, 93 Insert_String, 94 Trim_String, 95 Overwrite_String : String(1..10) := (others => Ada.Strings.Space); 96 97 Source_String1 : String(1..5) := "abcde"; -- odd length string 98 Source_String2 : String(1..6) := "abcdef"; -- even length string 99 Source_String3 : String(1..12) := "abcdefghijkl"; 100 Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad 101 Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad 102 Source_String6 : String(1..12) := "abcdefabcdef"; 103 104 Location : Natural := 0; 105 Slice_Start : Positive; 106 Slice_End, 107 Slice_Count : Natural := 0; 108 109 CD_Set : Maps.Character_Set := Maps.To_Set("cd"); 110 X_Set : Maps.Character_Set := Maps.To_Set('x'); 111 ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd"); 112 A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef"); 113 114 CD_to_XY_Map : Maps.Character_Mapping := 115 Maps.To_Mapping(From => "cd", To => "xy"); 116 117 begin 118 119 -- Procedure Replace_Slice 120 -- The functionality of this procedure 121 -- is similar to procedure Move, and 122 -- is tested here in the same manner, evaluated 123 -- with various combinations of parameters. 124 125 -- Index_Error propagation when Low > Source'Last + 1 126 127 begin 128 ASF.Replace_Slice(Result_String, 129 Result_String'Last + 2, -- should raise exception 130 Result_String'Last, 131 "xxxxxxx"); 132 Report.Failed("Index_Error not raised by Replace_Slice - 1"); 133 exception 134 when Ada.Strings.Index_Error => null; -- OK, expected exception. 135 when others => 136 Report.Failed("Incorrect exception from Replace_Slice - 1"); 137 end; 138 139 -- Index_Error propagation when High < Source'First - 1 140 141 begin 142 ASF.Replace_Slice(Result_String(5..10), 143 5, 144 3, -- should raise exception since < 'First - 1. 145 "xxxxxxx"); 146 Report.Failed("Index_Error not raised by Replace_Slice - 2"); 147 exception 148 when Ada.Strings.Index_Error => null; -- OK, expected exception. 149 when others => 150 Report.Failed("Incorrect exception from Replace_Slice - 2"); 151 end; 152 153 -- Justify = Left (default case) 154 155 Result_String := "XXXXXXXXXX"; 156 157 ASF.Replace_Slice(Source => Result_String, 158 Low => 1, 159 High => 10, 160 By => Source_String1); -- "abcde" 161 162 if Result_String /= "abcde " then 163 Report.Failed("Incorrect result from Replace_Slice - Justify = Left"); 164 end if; 165 166 -- Justify = Right 167 168 ASF.Replace_Slice(Source => Result_String, 169 Low => 1, 170 High => Result_String'Last, 171 By => Source_String2, -- "abcdef" 172 Drop => Ada.Strings.Error, 173 Justify => Ada.Strings.Right); 174 175 if Result_String /= " abcdef" then 176 Report.Failed("Incorrect result from Replace_Slice - Justify=Right"); 177 end if; 178 179 -- Justify = Center (two cases, odd and even pad lengths) 180 181 ASF.Replace_Slice(Result_String, 182 1, 183 Result_String'Last, 184 Source_String1, -- "abcde" 185 Ada.Strings.Error, 186 Ada.Strings.Center, 187 'x'); -- non-default padding. 188 189 if Result_String /= "xxabcdexxx" then -- Unequal padding added right 190 Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1"); 191 end if; 192 193 ASF.Replace_Slice(Result_String, 194 1, 195 Result_String'Last, 196 Source_String2, -- "abcdef" 197 Ada.Strings.Error, 198 Ada.Strings.Center); 199 200 if Result_String /= " abcdef " then -- Equal padding added on L/R. 201 Report.Failed("Incorrect result from Replace_Slice with " & 202 "Justify = Center - 2"); 203 end if; 204 205 -- When the source string is longer than the target string, several 206 -- cases can be examined, with the results depending on the value of 207 -- the Drop parameter. 208 209 -- Drop = Left 210 211 ASF.Replace_Slice(Result_String, 212 1, 213 Result_String'Last, 214 Source_String3, -- "abcdefghijkl" 215 Drop => Ada.Strings.Left); 216 217 if Result_String /= "cdefghijkl" then 218 Report.Failed("Incorrect result from Replace_Slice - Drop=Left"); 219 end if; 220 221 -- Drop = Right 222 223 ASF.Replace_Slice(Result_String, 224 1, 225 Result_String'Last, 226 Source_String3, -- "abcdefghijkl" 227 Ada.Strings.Right); 228 229 if Result_String /= "abcdefghij" then 230 Report.Failed("Incorrect result, Replace_Slice with Drop=Right"); 231 end if; 232 233 -- Drop = Error 234 235 -- The effect in this case depends on the value of the justify 236 -- parameter, and on whether any characters in Source other than 237 -- Pad would fail to be copied. 238 239 -- Drop = Error, Justify = Left, right overflow characters are pad. 240 241 ASF.Replace_Slice(Result_String, 242 1, 243 Result_String'Last, 244 Source_String4, -- "abcdefghij " 245 Drop => Ada.Strings.Error, 246 Justify => Ada.Strings.Left); 247 248 if not(Result_String = "abcdefghij") then -- leftmost 10 characters 249 Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1"); 250 end if; 251 252 -- Drop = Error, Justify = Right, left overflow characters are pad. 253 254 ASF.Replace_Slice(Source => Result_String, 255 Low => 1, 256 High => Result_String'Last, 257 By => Source_String5, -- " cdefghijkl" 258 Drop => Ada.Strings.Error, 259 Justify => Ada.Strings.Right); 260 261 if Result_String /= "cdefghijkl" then -- rightmost 10 characters 262 Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2"); 263 end if; 264 265 -- In other cases of Drop=Error, Length_Error is propagated, such as: 266 267 begin 268 269 ASF.Replace_Slice(Source => Result_String, 270 Low => 1, 271 High => Result_String'Last, 272 By => Source_String3, -- "abcdefghijkl" 273 Drop => Ada.Strings.Error); 274 275 Report.Failed("Length_Error not raised by Replace_Slice - 1"); 276 277 exception 278 when Ada.Strings.Length_Error => null; -- OK 279 when others => 280 Report.Failed("Incorrect exception from Replace_Slice - 3"); 281 end; 282 283 284 -- Function Replace_Slice 285 286 TC_Set_Name ("Replace_Slice"); 287 288 if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x")) 289 /= "abxde" or -- High = Low 290 TC_Check (ASF.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or 291 TC_Check (ASF.Replace_Slice("abcd", 4, 1, "xy")) 292 /= "abcxyd" or -- High < Low 293 TC_Check (ASF.Replace_Slice("abc", 2, 3, "x")) /= "ax" or 294 TC_Check (ASF.Replace_Slice("a", 1, 1, "z")) /= "z" 295 then 296 Report.Failed("Incorrect result from Function Replace_Slice - 1"); 297 end if; 298 299 if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z")) 300 /= "abcdz" or -- By length 1 301 TC_Check (ASF.Replace_Slice("abc", 1, 3, "xyz")) 302 /= "xyz" or -- High > Low 303 TC_Check (ASF.Replace_Slice("abc", 3, 2, "xy")) 304 /= "abxyc" or -- insert 305 TC_Check (ASF.Replace_Slice("a", 1, 1, "xyz")) /= "xyz" 306 then 307 Report.Failed("Incorrect result from Function Replace_Slice - 2"); 308 end if; 309 310 311 312 -- Function Insert. 313 314 TC_Set_Name ("Insert"); 315 316 declare 317 New_String : constant String := 318 TC_Check ( 319 ASF.Insert(Source => Source_String1(2..5), -- "bcde" 320 Before => 3, 321 New_Item => Source_String2)); -- "abcdef" 322 begin 323 if New_String /= "babcdefcde" then 324 Report.Failed("Incorrect result from Function Insert - 1"); 325 end if; 326 end; 327 328 if TC_Check (ASF.Insert("a", 1, "z")) /= "za" or 329 TC_Check (ASF.Insert("abc", 3, "")) /= "abc" or 330 TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc" 331 then 332 Report.Failed("Incorrect result from Function Insert - 2"); 333 end if; 334 335 begin 336 if TC_Check (ASF.Insert(Source => Source_String1(2..5), -- "bcde" 337 Before => Report.Ident_Int(7), 338 New_Item => Source_String2)) -- "abcdef" 339 /= "babcdefcde" then 340 Report.Failed("Index_Error not raised by Insert - 3A"); 341 else 342 Report.Failed("Index_Error not raised by Insert - 3B"); 343 end if; 344 exception 345 when Ada.Strings.Index_Error => null; -- OK, expected exception. 346 when others => 347 Report.Failed("Incorrect exception from Insert - 3"); 348 end; 349 350 351 -- Procedure Insert 352 353 -- Drop = Right 354 355 ASF.Insert(Source => Insert_String, 356 Before => 6, 357 New_Item => Source_String2, -- "abcdef" 358 Drop => Ada.Strings.Right); 359 360 if Insert_String /= " abcde" then -- last char of New_Item dropped. 361 Report.Failed("Incorrect result from Insert with Drop = Right"); 362 end if; 363 364 -- Drop = Left 365 366 ASF.Insert(Source => Insert_String, -- 10 char string 367 Before => 2, -- 9 chars, 2..10 available 368 New_Item => Source_String3, -- 12 characters long. 369 Drop => Ada.Strings.Left); -- truncate from Left. 370 371 if Insert_String /= "l abcde" then -- 10 chars, leading blank. 372 Report.Failed("Incorrect result from Insert with Drop=Left"); 373 end if; 374 375 -- Drop = Error 376 377 begin 378 ASF.Insert(Source => Result_String, -- 10 chars 379 Before => Result_String'Last, 380 New_Item => "abcdefghijk", 381 Drop => Ada.Strings.Error); 382 Report.Failed("Exception not raised by Procedure Insert"); 383 exception 384 when Ada.Strings.Length_Error => null; -- OK, expected exception 385 when others => 386 Report.Failed("Incorrect exception raised by Procedure Insert"); 387 end; 388 389 390 391 -- Function Overwrite 392 393 TC_Set_Name ("Overwrite"); 394 395 Overwrite_String := TC_Check ( 396 ASF.Overwrite(Result_String, -- 10 chars 397 1, -- starting at pos=1 398 Source_String3(1..10))); 399 400 if Overwrite_String /= Source_String3(1..10) then 401 Report.Failed("Incorrect result from Function Overwrite - 1"); 402 end if; 403 404 405 if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or 406 TC_Check (ASF.Overwrite("a", 1, "xyz")) 407 /= "xyz" or -- chars appended 408 TC_Check (ASF.Overwrite("abc", 3, " ")) 409 /= "ab " or -- blanks appended 410 TC_Check (ASF.Overwrite("abcde", 1, "z" )) /= "zbcde" 411 then 412 Report.Failed("Incorrect result from Function Overwrite - 2"); 413 end if; 414 415 416 417 -- Procedure Overwrite, with truncation. 418 419 ASF.Overwrite(Source => Overwrite_String, -- 10 characters. 420 Position => 1, 421 New_Item => Source_String3, -- 12 characters. 422 Drop => Ada.Strings.Left); 423 424 if Overwrite_String /= "cdefghijkl" then 425 Report.Failed("Incorrect result from Overwrite with Drop=Left"); 426 end if; 427 428 -- The default drop value is Right, used here. 429 430 ASF.Overwrite(Source => Overwrite_String, -- 10 characters. 431 Position => 1, 432 New_Item => Source_String3); -- 12 characters. 433 434 if Overwrite_String /= "abcdefghij" then 435 Report.Failed("Incorrect result from Overwrite with Drop=Right"); 436 end if; 437 438 -- Drop = Error 439 440 begin 441 ASF.Overwrite(Source => Overwrite_String, -- 10 characters. 442 Position => 1, 443 New_Item => Source_String3, -- 12 characters. 444 Drop => Ada.Strings.Error); 445 Report.Failed("Exception not raised by Procedure Overwrite"); 446 exception 447 when Ada.Strings.Length_Error => null; -- OK, expected exception. 448 when others => 449 Report.Failed 450 ("Incorrect exception raised by Procedure Overwrite"); 451 end; 452 453 Overwrite_String := "ababababab"; 454 ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z"); 455 ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z"); 456 ASF.Overwrite(Overwrite_String, 5, "zz"); 457 458 if Overwrite_String /= "zbabzzabaz" then 459 Report.Failed("Incorrect result from Procedure Overwrite"); 460 end if; 461 462 463 464 -- Function Delete 465 466 TC_Set_Name ("Delete"); 467 468 declare 469 New_String1 : constant String := -- This returns a 4 char string. 470 TC_Check (ASF.Delete(Source => Source_String3, 471 From => 3, 472 Through => 10)); 473 New_String2 : constant String := -- This returns Source. 474 TC_Check (ASF.Delete(Source_String3, 10, 3)); 475 begin 476 if New_String1 /= "abkl" or 477 New_String2 /= Source_String3 478 then 479 Report.Failed("Incorrect result from Function Delete - 1"); 480 end if; 481 end; 482 483 if TC_Check (ASF.Delete("a", 1, 1)) 484 /= "" or -- Source length = 1 485 TC_Check (ASF.Delete("abc", 1, 2)) 486 /= "c" or -- From = Source'First 487 TC_Check (ASF.Delete("abc", 3, 3)) 488 /= "ab" or -- From = Source'Last 489 TC_Check (ASF.Delete("abc", 3, 1)) 490 /= "abc" -- From > Through 491 then 492 Report.Failed("Incorrect result from Function Delete - 2"); 493 end if; 494 495 496 497 -- Procedure Delete 498 499 -- Justify = Left 500 501 Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij" 502 503 ASF.Delete(Source => Delete_String, 504 From => 6, 505 Through => Delete_String'Last, 506 Justify => Ada.Strings.Left, 507 Pad => 'x'); -- pad with char 'x' 508 509 if Delete_String /= "abcdexxxxx" then 510 Report.Failed("Incorrect result from Delete - Justify = Left"); 511 end if; 512 513 -- Justify = Right 514 515 ASF.Delete(Source => Delete_String, -- Remove x"s from end and 516 From => 6, -- shift right. 517 Through => Delete_String'Last, 518 Justify => Ada.Strings.Right, 519 Pad => 'x'); -- pad with char 'x' on left. 520 521 if Delete_String /= "xxxxxabcde" then 522 Report.Failed("Incorrect result from Delete - Justify = Right"); 523 end if; 524 525 -- Justify = Center 526 527 ASF.Delete(Source => Delete_String, 528 From => 1, 529 Through => 5, 530 Justify => Ada.Strings.Center, 531 Pad => 'z'); 532 533 if Delete_String /= "zzabcdezzz" then -- extra pad char on right side. 534 Report.Failed("Incorrect result from Delete - Justify = Center"); 535 end if; 536 537 538 539 -- Function Trim 540 -- Use non-identity character sets to perform the trim operation. 541 542 TC_Set_Name ("Trim"); 543 544 Trim_String := "cdabcdefcd"; 545 546 -- Remove the "cd" from each end of the string. This will not effect 547 -- the "cd" slice at 5..6. 548 549 declare 550 New_String : constant String := 551 TC_Check (ASF.Trim(Source => Trim_String, 552 Left => CD_Set, Right => CD_Set)); 553 begin 554 if New_String /= Source_String2 then -- string "abcdef" 555 Report.Failed("Incorrect result from Trim with character sets"); 556 end if; 557 end; 558 559 if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set)) 560 /= "abcdef" then 561 Report.Failed("Incorrect result from Trim with Null sets"); 562 end if; 563 564 if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then 565 Report.Failed("Incorrect result from Trim, string removal"); 566 end if; 567 568 569 -- Procedure Trim 570 571 -- Justify = Right 572 573 ASF.Trim(Source => Trim_String, 574 Left => CD_Set, 575 Right => CD_Set, 576 Justify => Ada.Strings.Right, 577 Pad => 'x'); 578 579 if Trim_String /= "xxxxabcdef" then 580 Report.Failed("Incorrect result from Trim with Justify = Right"); 581 end if; 582 583 -- Justify = Left 584 585 ASF.Trim(Source => Trim_String, 586 Left => X_Set, 587 Right => Maps.Null_Set, 588 Justify => Ada.Strings.Left, 589 Pad => Ada.Strings.Space); 590 591 if Trim_String /= "abcdef " then -- Padded with 4 blanks on right. 592 Report.Failed("Incorrect result from Trim with Justify = Left"); 593 end if; 594 595 -- Justify = Center 596 597 ASF.Trim(Source => Trim_String, 598 Left => ABCD_Set, 599 Right => CD_Set, 600 Justify => Ada.Strings.Center, 601 Pad => 'x'); 602 603 if Trim_String /= "xxef xx" then -- Padded with 2 pad chars on L/R 604 Report.Failed("Incorrect result from Trim with Justify = Center"); 605 end if; 606 607 608 609 -- Function Head, demonstrating use of padding. 610 611 TC_Set_Name ("Head"); 612 613 -- Use the characters of Source_String1 ("abcde") and pad the 614 -- last five characters of Result_String with 'x' characters. 615 616 617 Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x')); 618 619 if Result_String /= "abcdexxxxx" then 620 Report.Failed("Incorrect result from Function Head with padding"); 621 end if; 622 623 if TC_Check (ASF.Head(" ab ", 2)) /= " " or 624 TC_Check (ASF.Head("a", 6, 'A')) /= "aAAAAA" or 625 TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc" or 626 TC_Check (ASF.Head(ASF.Head("abc ", 7, 'x'), 10, 'X')) 627 /= "abc xxXXX" 628 then 629 Report.Failed("Incorrect result from Function Head"); 630 end if; 631 632 633 634 -- Function Tail, demonstrating use of padding. 635 636 TC_Set_Name ("Tail"); 637 638 -- Use the characters of Source_String1 ("abcde") and pad the 639 -- first five characters of Result_String with 'x' characters. 640 641 Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x')); 642 643 if Result_String /= "xxxxxabcde" then 644 Report.Failed("Incorrect result from Function Tail with padding"); 645 end if; 646 647 if TC_Check (ASF.Tail("abcde ", 5)) 648 /= "cde " or -- blanks, back 649 TC_Check (ASF.Tail(" abc ", 8, ' ')) 650 /= " abc " or -- blanks, front/back 651 TC_Check (ASF.Tail("", 5, 'Z')) 652 /= "ZZZZZ" or -- pad characters only 653 TC_Check (ASF.Tail("abc", 0)) 654 /= "" or -- null result 655 TC_Check (ASF.Tail("abcdefgh", 3)) 656 /= "fgh" or 657 TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'), 658 10, 659 'X')) /= "XXXXx abc " 660 then 661 Report.Failed("Incorrect result from Function Tail"); 662 end if; 663 664 665 -- Function "*" - with (Natural, String) parameters 666 667 TC_Set_Name ("""*"""); 668 669 if TC_Check (ASF."*"(3, Source_String1)) /= "abcdeabcdeabcde" or 670 TC_Check (ASF."*"(2, Source_String2)) /= Source_String6 or 671 TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab" or 672 TC_Check (ASF."*"(0, Source_String1)) /= "" 673 then 674 Report.Failed("Incorrect result from Function ""*"" with strings"); 675 end if; 676 677 exception 678 when others => Report.Failed("Exception raised in Test_Block"); 679 end Test_Block; 680 681 Report.Result; 682 683end CXA4005; 684