1-- CXA4026.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 Ada.Strings.Fixed procedures Head, Tail, and Trim, as well 28-- as the versions of subprograms Translate (procedure and function), 29-- Index, and Count, available in the package which use a 30-- Maps.Character_Mapping_Function input parameter, produce correct 31-- results. 32-- 33-- TEST DESCRIPTION: 34-- This test examines the operation of several subprograms contained in 35-- the Ada.Strings.Fixed package. 36-- This includes procedure versions of Head, Tail, and Trim, as well as 37-- four subprograms that use a Character_Mapping_Function as a parameter 38-- to provide the mapping capability. 39-- 40-- Two functions are defined to provide the mapping. Access values 41-- are defined to refer to these functions. One of the functions will 42-- map upper case characters in the range 'A'..'Z' to their lower case 43-- counterparts, while the other function will map lower case characters 44-- ('a'..'z', or a character whose position is in one of the ranges 45-- 223..246 or 248..255, provided the character has an upper case form) 46-- to their upper case form. 47-- 48-- Function Index uses the mapping function access value to map the input 49-- string prior to searching for the appropriate index value to return. 50-- Function Count uses the mapping function access value to map the input 51-- string prior to counting the occurrences of the pattern string. 52-- Both the Procedure and Function version of Translate use the mapping 53-- function access value to perform the translation. 54-- 55-- Results of all subprograms are compared with expected results. 56-- 57-- 58-- CHANGE HISTORY: 59-- 10 Feb 95 SAIC Initial prerelease version 60-- 21 Apr 95 SAIC Modified definition of string variable Str_2. 61-- 62--! 63 64 65package CXA4026_0 is 66 67 -- Function Map_To_Lower_Case will return the lower case form of 68 -- Characters in the range 'A'..'Z' only, and return the input 69 -- character otherwise. 70 71 function Map_To_Lower_Case (From : Character) return Character; 72 73 74 -- Function Map_To_Upper_Case will return the upper case form of 75 -- Characters in the range 'a'..'z', or whose position is in one 76 -- of the ranges 223..246 or 248..255, provided the character has 77 -- an upper case form. 78 79 function Map_To_Upper_Case (From : Character) return Character; 80 81end CXA4026_0; 82 83 84with Ada.Characters.Handling; 85package body CXA4026_0 is 86 87 function Map_To_Lower_Case (From : Character) return Character is 88 begin 89 if From in 'A'..'Z' then 90 return Character'Val(Character'Pos(From) - 91 (Character'Pos('A') - Character'Pos('a'))); 92 else 93 return From; 94 end if; 95 end Map_To_Lower_Case; 96 97 function Map_To_Upper_Case (From : Character) return Character is 98 begin 99 return Ada.Characters.Handling.To_Upper(From); 100 end Map_To_Upper_Case; 101 102end CXA4026_0; 103 104 105with CXA4026_0; 106with Ada.Strings.Fixed; 107with Ada.Strings.Maps; 108with Ada.Characters.Handling; 109with Ada.Characters.Latin_1; 110with Report; 111 112procedure CXA4026 is 113 114begin 115 116 Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " & 117 "as well as the versions of subprograms " & 118 "Translate, Index, and Count, which use the " & 119 "Character_Mapping_Function input parameter," & 120 "produce correct results"); 121 122 Test_Block: 123 declare 124 125 use Ada.Strings, CXA4026_0; 126 127 -- The following strings are used in examination of the Translation 128 -- subprograms. 129 130 New_Character_String : String(1..10) := 131 Ada.Characters.Latin_1.LC_A_Grave & 132 Ada.Characters.Latin_1.LC_A_Ring & 133 Ada.Characters.Latin_1.LC_AE_Diphthong & 134 Ada.Characters.Latin_1.LC_C_Cedilla & 135 Ada.Characters.Latin_1.LC_E_Acute & 136 Ada.Characters.Latin_1.LC_I_Circumflex & 137 Ada.Characters.Latin_1.LC_Icelandic_Eth & 138 Ada.Characters.Latin_1.LC_N_Tilde & 139 Ada.Characters.Latin_1.LC_O_Oblique_Stroke & 140 Ada.Characters.Latin_1.LC_Icelandic_Thorn; 141 142 143 TC_New_Character_String : String(1..10) := 144 Ada.Characters.Latin_1.UC_A_Grave & 145 Ada.Characters.Latin_1.UC_A_Ring & 146 Ada.Characters.Latin_1.UC_AE_Diphthong & 147 Ada.Characters.Latin_1.UC_C_Cedilla & 148 Ada.Characters.Latin_1.UC_E_Acute & 149 Ada.Characters.Latin_1.UC_I_Circumflex & 150 Ada.Characters.Latin_1.UC_Icelandic_Eth & 151 Ada.Characters.Latin_1.UC_N_Tilde & 152 Ada.Characters.Latin_1.UC_O_Oblique_Stroke & 153 Ada.Characters.Latin_1.UC_Icelandic_Thorn; 154 155 156 -- Functions used to supply mapping capability. 157 158 159 -- Access objects that will be provided as parameters to the 160 -- subprograms. 161 162 Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function := 163 Map_To_Lower_Case'Access; 164 165 Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function := 166 Map_To_Upper_Case'Access; 167 168 169 begin 170 171 -- Function Index, Forward direction search. 172 -- Note: Several of the following cases use the default value 173 -- Forward for the Going parameter. 174 175 if Fixed.Index(Source => "The library package Strings.Fixed", 176 Pattern => "fix", 177 Going => Ada.Strings.Forward, 178 Mapping => Map_To_Lower_Case_Ptr) /= 29 or 179 Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN", 180 "ain", 181 Mapping => Map_To_Lower_Case_Ptr) /= 6 or 182 Fixed.Index("maximum number", 183 "um", 184 Ada.Strings.Forward, 185 Map_To_Lower_Case_Ptr) /= 6 or 186 Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg", 187 "MIXED CASE STRING", 188 Ada.Strings.Forward, 189 Map_To_Upper_Case_Ptr) /= 12 or 190 Fixed.Index("STRING WITH NO MATCHING PATTERNS", 191 "WITH", 192 Ada.Strings.Forward, 193 Map_To_Lower_Case_Ptr) /= 0 or 194 Fixed.Index("THIS STRING IS IN UPPER CASE", 195 "IS", 196 Ada.Strings.Forward, 197 Map_To_Upper_Case_Ptr) /= 3 or 198 Fixed.Index("", -- Null string. 199 "is", 200 Mapping => Map_To_Lower_Case_Ptr) /= 0 or 201 Fixed.Index("AAABBBaaabbb", 202 "aabb", 203 Mapping => Map_To_Lower_Case_Ptr) /= 2 204 then 205 Report.Failed("Incorrect results from Function Index, going " & 206 "in Forward direction, using a Character Mapping " & 207 "Function parameter"); 208 end if; 209 210 211 212 -- Function Index, Backward direction search. 213 214 if Fixed.Index("Case of a Mixed Case String", 215 "case", 216 Ada.Strings.Backward, 217 Map_To_Lower_Case_Ptr) /= 17 or 218 Fixed.Index("Case of a Mixed Case String", 219 "CASE", 220 Ada.Strings.Backward, 221 Map_To_Upper_Case_Ptr) /= 17 or 222 Fixed.Index("rain, Rain, and more RAIN", 223 "rain", 224 Ada.Strings.Backward, 225 Map_To_Lower_Case_Ptr) /= 22 or 226 Fixed.Index("RIGHT place, right time", 227 "RIGHT", 228 Ada.Strings.Backward, 229 Map_To_Upper_Case_Ptr) /= 14 or 230 Fixed.Index("WOULD MATCH BUT FOR THE CASE", 231 "WOULD MATCH BUT FOR THE CASE", 232 Ada.Strings.Backward, 233 Map_To_Lower_Case_Ptr) /= 0 234 then 235 Report.Failed("Incorrect results from Function Index, going " & 236 "in Backward direction, using a Character Mapping " & 237 "Function parameter"); 238 end if; 239 240 241 242 -- Function Index, Pattern_Error if Pattern = Null_String 243 244 declare 245 use Ada.Strings.Fixed; 246 Null_Pattern_String : constant String := ""; 247 TC_Natural : Natural := 1000; 248 begin 249 TC_Natural := Index("A Valid String", 250 Null_Pattern_String, 251 Ada.Strings.Forward, 252 Map_To_Lower_Case_Ptr); 253 Report.Failed("Pattern_Error not raised by Function Index when " & 254 "given a null pattern string"); 255 exception 256 when Pattern_Error => null; -- OK, expected exception. 257 when others => 258 Report.Failed("Incorrect exception raised by Function Index " & 259 "using a Character Mapping Function parameter " & 260 "when given a null pattern string"); 261 end; 262 263 264 265 -- Function Count. 266 267 if Fixed.Count(Source => "ABABABA", 268 Pattern => "aba", 269 Mapping => Map_To_Lower_Case_Ptr) /= 2 or 270 Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /= 0 or 271 Fixed.Count("This IS a MISmatched issue", 272 "is", 273 Map_To_Lower_Case_Ptr) /= 4 or 274 Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /= 2 or 275 Fixed.Count("This IS a MISmatched issue", 276 "is", 277 Map_To_Upper_Case_Ptr) /= 0 or 278 Fixed.Count("She sells sea shells by the sea shore", 279 "s", 280 Map_To_Lower_Case_Ptr) /= 8 or 281 Fixed.Count("", -- Null string. 282 "match", 283 Map_To_Upper_Case_Ptr) /= 0 284 then 285 Report.Failed("Incorrect results from Function Count, using " & 286 "a Character Mapping Function parameter"); 287 end if; 288 289 290 291 -- Function Count, Pattern_Error if Pattern = Null_String 292 293 declare 294 use Ada.Strings.Fixed; 295 Null_Pattern_String : constant String := ""; 296 TC_Natural : Natural := 1000; 297 begin 298 TC_Natural := Count("A Valid String", 299 Null_Pattern_String, 300 Map_To_Lower_Case_Ptr); 301 Report.Failed("Pattern_Error not raised by Function Count using " & 302 "a Character Mapping Function parameter when " & 303 "given a null pattern string"); 304 exception 305 when Pattern_Error => null; -- OK, expected exception. 306 when others => 307 Report.Failed("Incorrect exception raised by Function Count " & 308 "using a Character Mapping Function parameter " & 309 "when given a null pattern string"); 310 end; 311 312 313 314 -- Function Translate. 315 316 if Fixed.Translate(Source => "A Sample Mixed Case String", 317 Mapping => Map_To_Lower_Case_Ptr) /= 318 "a sample mixed case string" or 319 320 Fixed.Translate("ALL LOWER CASE", 321 Map_To_Lower_Case_Ptr) /= 322 "all lower case" or 323 324 Fixed.Translate("end with lower case", 325 Map_To_Lower_Case_Ptr) /= 326 "end with lower case" or 327 328 Fixed.Translate("", Map_To_Lower_Case_Ptr) /= 329 "" or 330 331 Fixed.Translate("start with lower case", 332 Map_To_Upper_Case_Ptr) /= 333 "START WITH LOWER CASE" or 334 335 Fixed.Translate("ALL UPPER CASE STRING", 336 Map_To_Upper_Case_Ptr) /= 337 "ALL UPPER CASE STRING" or 338 339 Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs", 340 Map_To_Upper_Case_Ptr) /= 341 "LOTS OF MIXED CASE CHARACTERS" or 342 343 Fixed.Translate("", Map_To_Upper_Case_Ptr) /= 344 "" or 345 346 Fixed.Translate(New_Character_String, 347 Map_To_Upper_Case_Ptr) /= 348 TC_New_Character_String 349 then 350 Report.Failed("Incorrect results from Function Translate, using " & 351 "a Character Mapping Function parameter"); 352 end if; 353 354 355 356 -- Procedure Translate. 357 358 declare 359 360 use Ada.Strings.Fixed; 361 362 Str_1 : String(1..24) := "AN ALL UPPER CASE STRING"; 363 Str_2 : String(1..19) := "A Mixed Case String"; 364 Str_3 : String(1..32) := "a string with lower case letters"; 365 TC_Str_1 : constant String := Str_1; 366 TC_Str_3 : constant String := Str_3; 367 368 begin 369 370 Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr); 371 372 if Str_1 /= "an all upper case string" then 373 Report.Failed("Incorrect result from Procedure Translate - 1"); 374 end if; 375 376 Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr); 377 378 if Str_1 /= TC_Str_1 then 379 Report.Failed("Incorrect result from Procedure Translate - 2"); 380 end if; 381 382 Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr); 383 384 if Str_2 /= "a mixed case string" then 385 Report.Failed("Incorrect result from Procedure Translate - 3"); 386 end if; 387 388 Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr); 389 390 if Str_2 /= "A MIXED CASE STRING" then 391 Report.Failed("Incorrect result from Procedure Translate - 4"); 392 end if; 393 394 Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr); 395 396 if Str_3 /= TC_Str_3 then 397 Report.Failed("Incorrect result from Procedure Translate - 5"); 398 end if; 399 400 Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr); 401 402 if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then 403 Report.Failed("Incorrect result from Procedure Translate - 6"); 404 end if; 405 406 Translate(New_Character_String, Map_To_Upper_Case_Ptr); 407 408 if New_Character_String /= TC_New_Character_String then 409 Report.Failed("Incorrect result from Procedure Translate - 6"); 410 end if; 411 412 end; 413 414 415 -- Procedure Trim. 416 417 declare 418 Use Ada.Strings.Fixed; 419 Trim_String : String(1..30) := " A string of characters "; 420 begin 421 422 Trim(Source => Trim_String, 423 Side => Ada.Strings.Left, 424 Justify => Ada.Strings.Right, 425 Pad => 'x'); 426 427 if Trim_String /= "xxxxA string of characters " then 428 Report.Failed("Incorrect result from Procedure Trim, trim " & 429 "side = left, justify = right, pad = x"); 430 end if; 431 432 Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center); 433 434 if Trim_String /= " xxxxA string of characters " then 435 Report.Failed("Incorrect result from Procedure Trim, trim " & 436 "side = right, justify = center, default pad"); 437 end if; 438 439 Trim(Trim_String, Ada.Strings.Both, Pad => '*'); 440 441 if Trim_String /= "xxxxA string of characters****" then 442 Report.Failed("Incorrect result from Procedure Trim, trim " & 443 "side = both, default justify, pad = *"); 444 end if; 445 446 end; 447 448 449 -- Procedure Head. 450 451 declare 452 Fixed_String : String(1..20) := "A sample test string"; 453 begin 454 455 Fixed.Head(Source => Fixed_String, 456 Count => 14, 457 Justify => Ada.Strings.Center, 458 Pad => '$'); 459 460 if Fixed_String /= "$$$A sample test $$$" then 461 Report.Failed("Incorrect result from Procedure Head, " & 462 "justify = center, pad = $"); 463 end if; 464 465 Fixed.Head(Fixed_String, 11, Ada.Strings.Right); 466 467 if Fixed_String /= " $$$A sample" then 468 Report.Failed("Incorrect result from Procedure Head, " & 469 "justify = right, default pad"); 470 end if; 471 472 Fixed.Head(Fixed_String, 9, Pad => '*'); 473 474 if Fixed_String /= " ***********" then 475 Report.Failed("Incorrect result from Procedure Head, " & 476 "default justify, pad = *"); 477 end if; 478 479 end; 480 481 482 -- Procedure Tail. 483 484 declare 485 Use Ada.Strings.Fixed; 486 Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST"; 487 begin 488 489 Tail(Source => Tail_String, Count => 10, Pad => '-'); 490 491 if Tail_String /= "KLMNOPQRST----------" then 492 Report.Failed("Incorrect result from Procedure Tail, " & 493 "default justify, pad = -"); 494 end if; 495 496 Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a'); 497 498 if Tail_String /= "aaaaaaa------aaaaaaa" then 499 Report.Failed("Incorrect result from Procedure Tail, " & 500 "justify = center, pad = a"); 501 end if; 502 503 Tail(Tail_String, 1, Ada.Strings.Right); 504 505 if Tail_String /= " a" then 506 Report.Failed("Incorrect result from Procedure Tail, " & 507 "justify = right, default pad"); 508 end if; 509 510 Tail(Tail_String, 19, Ada.Strings.Right, 'A'); 511 512 if Tail_String /= "A a" then 513 Report.Failed("Incorrect result from Procedure Tail, " & 514 "justify = right, pad = A"); 515 end if; 516 517 end; 518 519 exception 520 when others => Report.Failed ("Exception raised in Test_Block"); 521 end Test_Block; 522 523 524 Report.Result; 525 526end CXA4026; 527