1-- CXA4009.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.Bounded are 28-- available, and that they produce correct results, especially under 29-- conditions where truncation of the result is required. Specifically, 30-- check the subprograms Overwrite (function and procedure), Delete, 31-- Function Trim (blanks), Trim (Set characters, function and procedure), 32-- Head, Tail, and Replicate (characters and strings). 33-- 34-- TEST DESCRIPTION: 35-- This test, in conjunction with tests CXA4006, CXA4007, and CXA4008, 36-- will provide coverage of the most common usages of the functionality 37-- found in the Ada.Strings.Bounded package. It deals in large part 38-- with truncation effects and options. This test contains many small, 39-- specific test cases, situations that are often difficult to generate 40-- in large numbers in an application-based test. These cases represent 41-- specific usage paradigms in-the-small. 42-- 43-- 44-- CHANGE HISTORY: 45-- 06 Dec 94 SAIC ACVC 2.0 46-- 10 Apr 95 SAIC Corrected errors in Procedure Overwrite subtests. 47-- 01 Nov 95 SAIC Fixed bugs for ACVC 2.0.1. 48-- 49--! 50 51with Report; 52with Ada.Strings.Bounded; 53with Ada.Strings.Maps; 54 55procedure CXA4009 is 56 57begin 58 59 Report.Test("CXA4009", "Check that the subprograms defined in " & 60 "package Ada.Strings.Bounded are available, " & 61 "and that they produce correct results, " & 62 "especially under conditions where " & 63 "truncation of the result is required"); 64 65 Test_Block: 66 declare 67 68 package AS renames Ada.Strings; 69 package ASB renames Ada.Strings.Bounded; 70 package Maps renames Ada.Strings.Maps; 71 72 package B10 is new ASB.Generic_Bounded_Length(Max => 10); 73 use type B10.Bounded_String; 74 75 Result_String : B10.Bounded_String; 76 Test_String : B10.Bounded_String; 77 AtoE_Bnd_Str : B10.Bounded_String := B10.To_Bounded_String("abcde"); 78 FtoJ_Bnd_Str : B10.Bounded_String := B10.To_Bounded_String("fghij"); 79 AtoJ_Bnd_Str : B10.Bounded_String := 80 B10.To_Bounded_String("abcdefghij"); 81 82 Location : Natural := 0; 83 Total_Count : Natural := 0; 84 85 CD_Set : Maps.Character_Set := Maps.To_Set("cd"); 86 XY_Set : Maps.Character_Set := Maps.To_Set("xy"); 87 88 89 begin 90 91 -- Function Overwrite with Truncation 92 -- Drop = Error (Default). 93 94 begin 95 Test_String := AtoJ_Bnd_Str; 96 Result_String := 97 B10.Overwrite(Source => Test_String, -- "abcdefghij" 98 Position => 9, 99 New_Item => "xyz", 100 Drop => AS.Error); 101 Report.Failed("Exception not raised by Function Overwrite"); 102 exception 103 when AS.Length_Error => null; -- Expected exception raised. 104 when others => 105 Report.Failed("Incorrect exception raised by Function Overwrite"); 106 end; 107 108 -- Drop = Left 109 110 Result_String := 111 B10.Overwrite(Source => Test_String, -- "abcdefghij" 112 Position => B10.Length(Test_String), -- 10 113 New_Item => "xyz", 114 Drop => Ada.Strings.Left); 115 116 if B10.To_String(Result_String) /= "cdefghixyz" then -- drop a,b 117 Report.Failed 118 ("Incorrect result from Function Overwrite, Drop = Left"); 119 end if; 120 121 -- Drop = Right 122 123 Result_String := B10.Overwrite(Test_String, -- "abcdefghij" 124 3, 125 "xxxyyyzzz", 126 Ada.Strings.Right); 127 128 if B10.To_String(Result_String) /= "abxxxyyyzz" then -- one 'z' dropped 129 Report.Failed 130 ("Incorrect result from Function Overwrite, Drop = Right"); 131 end if; 132 133 -- Additional cases of function Overwrite. 134 135 if B10.Overwrite(B10.To_Bounded_String("a"), -- Source length = 1 136 1, 137 " abc ") /= 138 B10.To_Bounded_String(" abc ") or 139 B10.Overwrite(B10.Null_Bounded_String, -- Null source 140 1, 141 "abcdefghij") /= 142 AtoJ_Bnd_Str or 143 B10.Overwrite(AtoE_Bnd_Str, 144 B10.To_String(AtoE_Bnd_Str)'First, 145 " ") /= -- New_Item = 1 146 B10.To_Bounded_String(" bcde") 147 then 148 Report.Failed("Incorrect result from Function Overwrite"); 149 end if; 150 151 152 153 -- Procedure Overwrite 154 -- Correct usage, no truncation. 155 156 Test_String := AtoE_Bnd_Str; -- "abcde" 157 B10.Overwrite(Test_String, 2, "xyz"); 158 159 if Test_String /= B10.To_Bounded_String("axyze") then 160 Report.Failed("Incorrect result from Procedure Overwrite - 1"); 161 end if; 162 163 Test_String := B10.To_Bounded_String("abc"); 164 B10.Overwrite(Test_String, 2, ""); -- New_Item is null string. 165 166 if Test_String /= B10.To_Bounded_String("abc") then 167 Report.Failed("Incorrect result from Procedure Overwrite - 2"); 168 end if; 169 170 -- Drop = Error (Default). 171 172 begin 173 Test_String := AtoJ_Bnd_Str; 174 B10.Overwrite(Source => Test_String, -- "abcdefghij" 175 Position => 8, 176 New_Item => "uvwxyz"); 177 Report.Failed("Exception not raised by Procedure Overwrite"); 178 exception 179 when AS.Length_Error => null; -- Expected exception raised. 180 when others => 181 Report.Failed("Incorrect exception raised by Procedure Overwrite"); 182 end; 183 184 -- Drop = Left 185 186 Test_String := AtoJ_Bnd_Str; 187 B10.Overwrite(Source => Test_String, -- "abcdefghij" 188 Position => B10.Length(Test_String) - 2, -- 8 189 New_Item => "uvwxyz", 190 Drop => Ada.Strings.Left); 191 192 if B10.To_String(Test_String) /= "defguvwxyz" then -- drop a-c 193 Report.Failed 194 ("Incorrect result from Procedure Overwrite, Drop = Left"); 195 end if; 196 197 -- Drop = Right 198 199 Test_String := AtoJ_Bnd_Str; 200 B10.Overwrite(Test_String, -- "abcdefghij" 201 3, 202 "xxxyyyzzz", 203 Ada.Strings.Right); 204 205 if B10.To_String(Test_String) /= "abxxxyyyzz" then -- one 'z' dropped 206 Report.Failed 207 ("Incorrect result from Procedure Overwrite, Drop = Right"); 208 end if; 209 210 211 212 -- Function Delete 213 214 if B10.Delete(Source => AtoJ_Bnd_Str, -- "abcdefghij" 215 From => 3, 216 Through => 8) /= 217 B10."&"(B10.Head(AtoJ_Bnd_Str, 2), 218 B10.Tail(AtoJ_Bnd_Str, 2)) or 219 B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str)) /= 220 AtoE_Bnd_Str or 221 B10.Delete(AtoJ_Bnd_Str, 1, 5) /= 222 FtoJ_Bnd_Str or 223 B10.Delete(AtoE_Bnd_Str, 4, 5) /= 224 B10.Delete(AtoJ_Bnd_Str, 4, B10.Length(AtoJ_Bnd_Str)) 225 then 226 Report.Failed("Incorrect result from Function Delete - 1"); 227 end if; 228 229 if B10.Delete(B10.To_Bounded_String("a"), 1, 1) /= 230 B10.Null_Bounded_String or 231 B10.Delete(AtoE_Bnd_Str, 232 5, 233 B10.To_String(AtoE_Bnd_Str)'First) /= 234 AtoE_Bnd_Str or 235 B10.Delete(AtoE_Bnd_Str, 236 B10.To_String(AtoE_Bnd_Str)'Last, 237 B10.To_String(AtoE_Bnd_Str)'Last) /= 238 B10.To_Bounded_String("abcd") 239 then 240 Report.Failed("Incorrect result from Function Delete - 2"); 241 end if; 242 243 244 245 -- Function Trim 246 247 declare 248 249 Text : B10.Bounded_String := B10.To_Bounded_String("Text"); 250 type Bnd_Array_Type is array (1..5) of B10.Bounded_String; 251 Bnd_Array : Bnd_Array_Type := 252 (B10.To_Bounded_String(" Text"), 253 B10.To_Bounded_String("Text "), 254 B10.To_Bounded_String(" Text "), 255 B10.To_Bounded_String("Text Text"), -- Ensure no inter-string 256 B10.To_Bounded_String(" Text Text")); -- trimming of blanks. 257 258 begin 259 260 for i in Bnd_Array_Type'Range loop 261 case i is 262 when 4 => 263 if B10.Trim(Bnd_Array(i), AS.Both) /= 264 Bnd_Array(i) then -- no change 265 Report.Failed("Incorrect result from Function Trim - 4"); 266 end if; 267 when 5 => 268 if B10.Trim(Bnd_Array(i), AS.Both) /= 269 B10."&"(Text, B10."&"(' ', Text)) then 270 Report.Failed("Incorrect result from Function Trim - 5"); 271 end if; 272 when others => 273 if B10.Trim(Bnd_Array(i), AS.Both) /= Text then 274 Report.Failed("Incorrect result from Function Trim - " & 275 Integer'Image(i)); 276 end if; 277 end case; 278 end loop; 279 280 end; 281 282 283 284 -- Function Trim using Sets 285 286 -- Trim characters in sets from both sides of the bounded string. 287 if B10.Trim(Source => B10.To_Bounded_String("ddabbaxx"), 288 Left => CD_Set, 289 Right => XY_Set) /= 290 B10.To_Bounded_String("abba") 291 then 292 Report.Failed 293 ("Incorrect result from Fn Trim - Sets, Left & Right side - 1"); 294 end if; 295 296 -- Ensure that the characters in the set provided as the actual to 297 -- parameter Right are not trimmed from the left side of the bounded 298 -- string; likewise for the opposite side. Only "cd" trimmed from left 299 -- side, and only "xy" trimmed from right side. 300 301 if B10.Trim(B10.To_Bounded_String("cdxyabcdxy"), CD_Set, XY_Set) /= 302 B10.To_Bounded_String("xyabcd") 303 then 304 Report.Failed 305 ("Incorrect result from Fn Trim - Sets, Left & Right side - 2"); 306 end if; 307 308 -- Ensure that characters contained in the sets are not trimmed from 309 -- the "interior" of the bounded string, just the appropriate ends. 310 311 if B10.Trim(B10.To_Bounded_String("cdabdxabxy"), CD_Set, XY_Set) /= 312 B10.To_Bounded_String("abdxab") 313 then 314 Report.Failed 315 ("Incorrect result from Fn Trim - Sets, Left & Right side - 3"); 316 end if; 317 318 -- Trim characters in set from right side only. No change to Left side. 319 320 if B10.Trim(B10.To_Bounded_String("abxyzddcd"), XY_Set, CD_Set) /= 321 B10.To_Bounded_String("abxyz") 322 then 323 Report.Failed 324 ("Incorrect result from Fn Trim - Sets, Right side"); 325 end if; 326 327 -- Trim no characters on either side of the bounded string. 328 329 Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set); 330 if Result_String /= AtoJ_Bnd_Str then 331 Report.Failed("Incorrect result from Fn Trim - Sets, Neither side"); 332 end if; 333 334 if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /= 335 AtoE_Bnd_Str or 336 B10.Trim(B10.To_Bounded_String("dcddcxyyxx"), 337 CD_Set, 338 XY_Set) /= 339 B10.Null_Bounded_String 340 then 341 Report.Failed("Incorrect result from Function Trim"); 342 end if; 343 344 345 346 -- Procedure Trim using Sets 347 348 -- Trim characters in sets from both sides of the bounded string. 349 350 Test_String := B10.To_Bounded_String("dcabbayx"); 351 B10.Trim(Source => Test_String, 352 Left => CD_Set, 353 Right => XY_Set); 354 355 if Test_String /= B10.To_Bounded_String("abba") then 356 Report.Failed 357 ("Incorrect result from Proc Trim - Sets, Left & Right side - 1"); 358 end if; 359 360 -- Ensure that the characters in the set provided as the actual to 361 -- parameter Right are not trimmed from the left side of the bounded 362 -- string; likewise for the opposite side. Only "cd" trimmed from left 363 -- side, and only "xy" trimmed from right side. 364 365 Test_String := B10.To_Bounded_String("cdxyabcdxy"); 366 B10.Trim(Test_String, CD_Set, XY_Set); 367 368 if Test_String /= B10.To_Bounded_String("xyabcd") then 369 Report.Failed 370 ("Incorrect result from Proc Trim - Sets, Left & Right side - 2"); 371 end if; 372 373 -- Ensure that characters contained in the sets are not trimmed from 374 -- the "interior" of the bounded string, just the appropriate ends. 375 376 Test_String := B10.To_Bounded_String("cdabdxabxy"); 377 B10.Trim(Test_String, CD_Set, XY_Set); 378 379 if not (Test_String = B10.To_Bounded_String("abdxab")) then 380 Report.Failed 381 ("Incorrect result from Proc Trim - Sets, Left & Right side - 3"); 382 end if; 383 384 -- Trim characters in set from Left side only. No change to Right side. 385 386 Test_String := B10.To_Bounded_String("cccdabxyz"); 387 B10.Trim(Test_String, CD_Set, XY_Set); 388 389 if Test_String /= B10.To_Bounded_String("abxyz") then 390 Report.Failed 391 ("Incorrect result from Proc Trim for Sets, Left side only"); 392 end if; 393 394 -- Trim no characters on either side of the bounded string. 395 396 Test_String := AtoJ_Bnd_Str; 397 B10.Trim(Test_String, CD_Set, CD_Set); 398 399 if Test_String /= AtoJ_Bnd_Str then 400 Report.Failed("Incorrect result from Proc Trim-Sets, Neither side"); 401 end if; 402 403 404 405 -- Function Head with Truncation 406 -- Drop = Error (Default). 407 408 begin 409 Result_String := B10.Head(Source => AtoJ_Bnd_Str, -- max length 410 Count => B10.Length(AtoJ_Bnd_Str) + 1, 411 Pad => 'X'); 412 Report.Failed("Length_Error not raised by Function Head"); 413 exception 414 when AS.Length_Error => null; -- Expected exception raised. 415 when others => 416 Report.Failed("Incorrect exception raised by Function Head"); 417 end; 418 419 -- Drop = Left 420 421 -- Pad characters (5) are appended to the right end of the string 422 -- (which is initially at its maximum length), then the first five 423 -- characters of the intermediate result are dropped to conform to 424 -- the maximum size limit of the bounded string (10). 425 426 Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHIJ"), 427 15, 428 'x', 429 Ada.Strings.Left); 430 431 if Result_String /= B10.To_Bounded_String("FGHIJxxxxx") then 432 Report.Failed("Incorrect result from Function Head, Drop = Left"); 433 end if; 434 435 -- Drop = Right 436 437 -- Pad characters (6) are appended to the left end of the string 438 -- (which is initially at one less than its maximum length), then the 439 -- last five characters of the intermediate result are dropped 440 -- (which in this case are the pad characters) to conform to the 441 -- maximum size limit of the bounded string (10). 442 443 Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHI"), 444 15, 445 'x', 446 Ada.Strings.Right); 447 448 if Result_String /= B10.To_Bounded_String("ABCDEFGHIx") then 449 Report.Failed("Incorrect result from Function Head, Drop = Right"); 450 end if; 451 452 -- Additional cases. 453 454 if B10.Head(B10.Null_Bounded_String, 5) /= 455 B10.To_Bounded_String(" ") or 456 B10.Head(AtoE_Bnd_Str, 457 B10.Length(AtoE_Bnd_Str)) /= 458 AtoE_Bnd_Str 459 then 460 Report.Failed("Incorrect result from Function Head"); 461 end if; 462 463 464 465 -- Function Tail with Truncation 466 -- Drop = Error (Default Case) 467 468 begin 469 Result_String := B10.Tail(Source => AtoJ_Bnd_Str, -- max length 470 Count => B10.Length(AtoJ_Bnd_Str) + 1, 471 Pad => Ada.Strings.Space, 472 Drop => Ada.Strings.Error); 473 Report.Failed("Length_Error not raised by Function Tail"); 474 exception 475 when AS.Length_Error => null; -- Expected exception raised. 476 when others => 477 Report.Failed("Incorrect exception raised by Function Tail"); 478 end; 479 480 -- Drop = Left 481 482 -- Pad characters (5) are appended to the left end of the string 483 -- (which is initially at two less than its maximum length), then 484 -- the first three characters of the intermediate result (in this 485 -- case, 3 pad characters) are dropped. 486 487 Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGH"), -- 8 ch 488 13, 489 'x', 490 Ada.Strings.Left); 491 492 if Result_String /= B10.To_Bounded_String("xxABCDEFGH") then 493 Report.Failed("Incorrect result from Function Tail, Drop = Left"); 494 end if; 495 496 -- Drop = Right 497 498 -- Pad characters (3) are appended to the left end of the string 499 -- (which is initially at its maximum length), then the last three 500 -- characters of the intermediate result are dropped. 501 502 Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGHIJ"), 503 13, 504 'x', 505 Ada.Strings.Right); 506 507 if Result_String /= B10.To_Bounded_String("xxxABCDEFG") then 508 Report.Failed("Incorrect result from Function Tail, Drop = Right"); 509 end if; 510 511 -- Additional cases. 512 513 if B10.Tail(B10.Null_Bounded_String, 3, ' ') /= 514 B10.To_Bounded_String(" ") or 515 B10.Tail(AtoE_Bnd_Str, 516 B10.To_String(AtoE_Bnd_Str)'First) /= 517 B10.To_Bounded_String("e") 518 then 519 Report.Failed("Incorrect result from Function Tail"); 520 end if; 521 522 523 524 -- Function Replicate (#, Char) with Truncation 525 -- Drop = Error (Default). 526 527 begin 528 Result_String := B10.Replicate(Count => B10.Max_Length + 5, 529 Item => 'A', 530 Drop => AS.Error); 531 Report.Failed 532 ("Length_Error not raised by Replicate for characters"); 533 exception 534 when AS.Length_Error => null; -- Expected exception raised. 535 when others => 536 Report.Failed 537 ("Incorrect exception raised by Replicate for characters"); 538 end; 539 540 -- Drop = Left, Right 541 -- Since this version of Replicate uses character parameters, the 542 -- result after truncation from left or right will appear the same. 543 -- The result will be a 10 character bounded string, composed of 10 544 -- "Item" characters. 545 546 if B10.Replicate(Count => 20, Item => 'A', Drop => Ada.Strings.Left) /= 547 B10.Replicate(15, 'A', Ada.Strings.Right) 548 then 549 Report.Failed("Incorrect result from Replicate for characters - 1"); 550 end if; 551 552 -- Blank-filled 10 character bounded strings. 553 554 if B10.Replicate(B10.Max_Length + 1, ' ', Drop => Ada.Strings.Left) /= 555 B10.Replicate(B10.Max_Length, Ada.Strings.Space) 556 then 557 Report.Failed("Incorrect result from Replicate for characters - 2"); 558 end if; 559 560 -- Additional cases. 561 562 if B10.Replicate(0, 'a') /= B10.Null_Bounded_String or 563 B10.Replicate(1, 'a') /= B10.To_Bounded_String("a") 564 then 565 Report.Failed("Incorrect result from Replicate for characters - 3"); 566 end if; 567 568 569 570 -- Function Replicate (#, String) with Truncation 571 -- Drop = Error (Default). 572 573 begin 574 Result_String := B10.Replicate(Count => 5, -- result would be 15. 575 Item => "abc"); 576 Report.Failed 577 ("Length_Error not raised by Replicate for strings"); 578 exception 579 when AS.Length_Error => null; -- Expected exception raised. 580 when others => 581 Report.Failed 582 ("Incorrect exception raised by Replicate for strings"); 583 end; 584 585 -- Drop = Left 586 587 Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Left); 588 589 if Result_String /= B10.To_Bounded_String("cdabcdabcd") then 590 Report.Failed 591 ("Incorrect result from Replicate for strings, Drop = Left"); 592 end if; 593 594 -- Drop = Right 595 596 Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Right); 597 598 if Result_String /= B10.To_Bounded_String("abcdabcdab") then 599 Report.Failed 600 ("Incorrect result from Replicate for strings, Drop = Right"); 601 end if; 602 603 -- Additional cases. 604 605 if B10.Replicate(10, "X") /= B10.To_Bounded_String("XXXXXXXXXX") or 606 B10.Replicate(10, "") /= B10.Null_Bounded_String or 607 B10.Replicate( 0, "ab") /= B10.Null_Bounded_String 608 then 609 Report.Failed("Incorrect result from Replicate for strings"); 610 end if; 611 612 613 exception 614 when others => Report.Failed("Exception raised in Test_Block"); 615 end Test_Block; 616 617 Report.Result; 618 619end CXA4009; 620