1-- CXA4025.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 functionality found in packages Ada.Strings.Wide_Maps, 28-- Ada.Strings.Wide_Fixed, and Ada.Strings.Wide_Maps.Wide_Constants 29-- is available and produces correct results. 30-- 31-- TEST DESCRIPTION: 32-- This test validates the subprograms found in the various Wide_Map 33-- and Wide_String packages. It is based on the tests CXA4024 and 34-- CXA4026, which are tests for the complementary "non-wide" packages. 35-- 36-- The functions found in CXA4025_0 provide mapping capability, when 37-- used in conjunction with Wide_Character_Mapping_Function objects. 38-- 39-- 40-- CHANGE HISTORY: 41-- 23 Jun 95 SAIC Initial prerelease version. 42-- 15 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. 43-- 44--! 45 46package CXA4025_0 is 47 -- Functions used to supply mapping capability. 48 function Map_To_Lower_Case (From : Wide_Character) return Wide_Character; 49 function Map_To_Upper_Case (From : Wide_Character) return Wide_Character; 50end CXA4025_0; 51 52with Ada.Characters.Handling; 53package body CXA4025_0 is 54 -- Function Map_To_Lower_Case will return the lower case form of 55 -- Wide_Characters in the range 'A'..'Z' only, and return the input 56 -- wide_character otherwise. 57 58 function Map_To_Lower_Case (From : Wide_Character) 59 return Wide_Character is 60 begin 61 return Ada.Characters.Handling.To_Wide_Character( 62 Ada.Characters.Handling.To_Lower( 63 Ada.Characters.Handling.To_Character(From))); 64 end Map_To_Lower_Case; 65 66 -- Function Map_To_Upper_Case will return the upper case form of 67 -- Wide_Characters in the range 'a'..'z', or whose position is in one 68 -- of the ranges 223..246 or 248..255, provided the wide_character has 69 -- an upper case form. 70 71 function Map_To_Upper_Case (From : Wide_Character) 72 return Wide_Character is 73 begin 74 return Ada.Characters.Handling.To_Wide_Character( 75 Ada.Characters.Handling.To_Upper( 76 Ada.Characters.Handling.To_Character(From))); 77 end Map_To_Upper_Case; 78 79end CXA4025_0; 80 81 82with CXA4025_0; 83with Report; 84with Ada.Characters.Handling; 85with Ada.Characters.Latin_1; 86with Ada.Exceptions; 87with Ada.Strings; 88with Ada.Strings.Wide_Maps; 89with Ada.Strings.Wide_Maps.Wide_Constants; 90with Ada.Strings.Wide_Fixed; 91 92procedure CXA4025 is 93begin 94 Report.Test ("CXA4025", 95 "Check that subprograms defined in packages " & 96 "Ada.Strings.Wide_Maps and Ada.Strings.Wide_Fixed " & 97 "produce correct results"); 98 99 Test_Block: 100 declare 101 102 package ACL1 renames Ada.Characters.Latin_1; 103 104 use Ada.Characters, Ada.Strings; 105 use Ada.Exceptions; 106 use type Wide_Maps.Wide_Character_Set; 107 108 subtype LC_Characters is Wide_Character range 'a'..'z'; 109 110 Last_Letter : constant := 26; 111 Vowels : constant Wide_Maps.Wide_Character_Sequence := "aeiou"; 112 TC_String : constant Wide_String := "A Standard String"; 113 114 Alphabet : Wide_Maps.Wide_Character_Sequence (1..Last_Letter); 115 Alphabet_Set, 116 Consonant_Set, 117 Vowel_Set : Wide_Maps.Wide_Character_Set; 118 119 String_20 : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; 120 String_40 : Wide_String(1..40) := "abcdefghijklmnopqrst" & 121 String_20; 122 String_80 : Wide_String(1..80) := String_40 & String_40; 123 TC_String_5 : Wide_String(1..5) := "ABCDE"; 124 125 -- The following strings are used in examination of the Translation 126 -- subprograms. 127 New_Character_String : Wide_String(1..12) := 128 Handling.To_Wide_String( 129 ACL1.LC_A_Grave & ACL1.LC_A_Ring & ACL1.LC_AE_Diphthong & 130 ACL1.LC_C_Cedilla & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex & 131 ACL1.LC_Icelandic_Eth & ACL1.LC_N_Tilde & 132 ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn & 133 ACL1.LC_German_Sharp_S & ACL1.LC_Y_Diaeresis); 134 135 -- Note that there is no upper case version of the last two 136 -- characters from above. 137 138 TC_New_Character_String : Wide_String(1..12) := 139 Handling.To_Wide_String( 140 ACL1.UC_A_Grave & ACL1.UC_A_Ring & ACL1.UC_AE_Diphthong & 141 ACL1.UC_C_Cedilla & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex & 142 ACL1.UC_Icelandic_Eth & ACL1.UC_N_Tilde & 143 ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn & 144 ACL1.LC_German_Sharp_S & ACL1.LC_Y_Diaeresis); 145 146 -- Access objects that will be provided as parameters to the 147 -- subprograms. 148 Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := 149 CXA4025_0.Map_To_Lower_Case'Access; 150 Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := 151 CXA4025_0.Map_To_Upper_Case'Access; 152 153 begin 154 155 -- 156 -- Testing of functionality found in Package Ada.Strings.Wide_Maps. 157 -- 158 159 -- Load the alphabet strings for use in creating sets. 160 for i in 0..25 loop 161 Alphabet(i+1) := Wide_Character'Val(Wide_Character'Pos('a')+i); 162 end loop; 163 164 -- Initialize a series of Character_Set objects. 165 Alphabet_Set := Wide_Maps.To_Set(Alphabet); 166 Vowel_Set := Wide_Maps.To_Set(Vowels); 167 Consonant_Set := Vowel_Set XOR Alphabet_Set; 168 169 -- Evaluation of Set operator "-". 170 if 171 (Alphabet_Set - Consonant_Set) /= 172 "AND"(Alphabet_Set, "NOT"(Consonant_Set)) or 173 (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) 174 then 175 Report.Failed("Incorrect result from ""-"" operator for sets"); 176 end if; 177 178 -- Evaluation of Functions To_Domain and To_Range. 179 declare 180 Null_Sequence : constant Wide_Maps.Wide_Character_Sequence := ""; 181 TC_UC_Sequence : constant Wide_Maps.Wide_Character_Sequence := 182 "ZYXWVUTSRQPONMABCDEFGHIJKL"; 183 TC_LC_Sequence : constant Wide_Maps.Wide_Character_Sequence := 184 "zyxwvutsrqponmabcdefghijkl"; 185 TC_Upper_to_Lower_Map : Wide_Maps.Wide_Character_Mapping := 186 Wide_Maps.To_Mapping(TC_UC_Sequence, 187 TC_LC_Sequence); 188 TC_Lower_to_Upper_Map : Wide_Maps.Wide_Character_Mapping := 189 Wide_Maps.To_Mapping(TC_LC_Sequence, 190 TC_UC_Sequence); 191 begin 192 declare 193 TC_Domain : constant Wide_Maps.Wide_Character_Sequence := 194 Wide_Maps.To_Domain(TC_Upper_to_Lower_Map); 195 TC_Range : constant Wide_Maps.Wide_Character_Sequence := 196 Wide_Maps.To_Range(TC_Lower_to_Upper_Map); 197 begin 198 -- Function To_Domain returns the shortest Wide_Character_Sequence 199 -- value such that each wide character not in the result maps to 200 -- itself, and all wide characters in the result are in ascending 201 -- order. 202 if TC_Domain /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then 203 Report.Failed("Incorrect result from To_Domain with " & 204 "TC_Upper_to_Lower_Map as input"); 205 end if; 206 207 -- The lower bound on the returned Wide_Character_Sequence value 208 -- from To_Domain must be 1. 209 if TC_Domain'First /= 1 then 210 Report.Failed("Incorrect lower bound returned from To_Domain"); 211 end if; 212 213 -- Check contents of result of To_Range. 214 if TC_Range /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then 215 Report.Failed("Incorrect result from To_Range with " & 216 "TC_Lower_to_Upper_Map as input"); 217 end if; 218 219 -- The lower bound on the returned Character_Sequence value 220 -- must be 1. 221 if TC_Range'First /= 1 then 222 Report.Failed("Incorrect lower bound returned from To_Range"); 223 end if; 224 225 if TC_Range'Last /= TC_LC_Sequence'Length then 226 Report.Failed("Incorrect upper bound returned from To_Range"); 227 end if; 228 end; 229 230 -- Both function To_Domain and To_Range return the null string 231 -- when provided the Identity character map as an input parameter. 232 if Wide_Maps.To_Domain(Wide_Maps.Identity) /= Null_Sequence or 233 Wide_Maps.To_Range(Wide_Maps.Identity) /= Null_Sequence 234 then 235 Report.Failed("Null sequence not returned from To_Domain or " & 236 "To_Range when provided the Identity map as input"); 237 end if; 238 exception 239 when others => 240 Report.Failed("Exception raised during the evaluation of " & 241 "Function To_Domain and To_Range"); 242 end; 243 244 -- Testing of functionality found in Package Ada.Strings.Wide_Fixed. 245 -- 246 -- Function Index, Forward direction search. 247 248 if Wide_Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg", 249 "MIXED CASE STRING", 250 Ada.Strings.Forward, 251 Map_To_Upper_Case_Ptr) /= 12 or 252 Wide_Fixed.Index("STRING WITH NO MATCHING PATTERNS", 253 "WITH", 254 Ada.Strings.Forward, 255 Map_To_Lower_Case_Ptr) /= 0 256 then 257 Report.Failed("Incorrect results from Function Index, going " & 258 "in Forward direction, using a Character Mapping " & 259 "Function parameter"); 260 end if; 261 262 -- Function Index, Backward direction search. 263 if Wide_Fixed.Index("Case of a Mixed Case String", 264 "case", 265 Ada.Strings.Backward, 266 Map_To_Lower_Case_Ptr) /= 17 or 267 Wide_Fixed.Index("WOULD MATCH BUT FOR THE CASE", 268 "WOULD MATCH BUT FOR THE CASE", 269 Ada.Strings.Backward, 270 Map_To_Lower_Case_Ptr) /= 0 271 then 272 Report.Failed("Incorrect results from Function Index, going " & 273 "in Backward direction, using a Character Mapping " & 274 "Function parameter"); 275 end if; 276 277 -- Function Count. 278 if Wide_Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /= 2 or 279 Wide_Fixed.Count("", "match", Map_To_Lower_Case_Ptr) /= 0 280 then 281 Report.Failed("Incorrect results from Function Count, using " & 282 "a Character Mapping Function parameter"); 283 end if; 284 285 -- Function Translate. 286 if Wide_Fixed.Translate(Source => "A Sample Mixed Case String", 287 Mapping => Map_To_Lower_Case_Ptr) /= 288 "a sample mixed case string" or 289 Wide_Fixed.Translate(New_Character_String, 290 Map_To_Upper_Case_Ptr) /= 291 TC_New_Character_String 292 then 293 Report.Failed("Incorrect results from Function Translate, using " & 294 "a Wide_Character Mapping Function parameter"); 295 end if; 296 297 -- Procedure Translate. 298 declare 299 use Ada.Strings.Wide_Fixed; 300 Str : Wide_String(1..19) := "A Mixed Case String"; 301 begin 302 Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr); 303 if Str /= "a mixed case string" then 304 Report.Failed("Incorrect result from Procedure Translate - 1"); 305 end if; 306 307 Translate(New_Character_String, Map_To_Upper_Case_Ptr); 308 if New_Character_String /= TC_New_Character_String then 309 Report.Failed("Incorrect result from Procedure Translate - 2"); 310 end if; 311 end; 312 313 -- Procedure Trim. 314 declare 315 use Ada.Strings.Wide_Fixed; 316 Trim_String : Wide_String(1..30) := " A string of characters "; 317 begin 318 Trim(Trim_String, Ada.Strings.Left, Ada.Strings.Right, 'x'); 319 if Trim_String /= "xxxxA string of characters " then 320 Report.Failed("Incorrect result from Procedure Trim, trim " & 321 "side = left, justify = right, pad = x"); 322 end if; 323 324 Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center); 325 if Trim_String /= " xxxxA string of characters " then 326 Report.Failed("Incorrect result from Procedure Trim, trim " & 327 "side = right, justify = center, default pad"); 328 end if; 329 end; 330 331 -- Procedure Head. 332 declare 333 Fixed_String : Wide_String(1..20) := "A sample test string"; 334 begin 335 Wide_Fixed.Head(Source => Fixed_String, Count => 14, 336 Justify => Ada.Strings.Center, Pad => '$'); 337 if Fixed_String /= "$$$A sample test $$$" then 338 Report.Failed("Incorrect result from Procedure Head, " & 339 "justify = center, pad = $"); 340 end if; 341 342 Wide_Fixed.Head(Fixed_String, 11, Ada.Strings.Right); 343 if Fixed_String /= " $$$A sample" then 344 Report.Failed("Incorrect result from Procedure Head, " & 345 "justify = right, default pad"); 346 end if; 347 end; 348 349 -- Procedure Tail. 350 declare 351 use Ada.Strings.Wide_Fixed; 352 Tail_String : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; 353 begin 354 -- Default left justify. 355 Tail(Source => Tail_String, Count => 10, Pad => '-'); 356 if Tail_String /= "KLMNOPQRST----------" then 357 Report.Failed("Incorrect result from Procedure Tail, " & 358 "default justify, pad = -"); 359 end if; 360 361 Tail(Tail_String, 6, Ada.Strings.Center, 'a'); 362 if Tail_String /= "aaaaaaa------aaaaaaa" then 363 Report.Failed("Incorrect result from Procedure Tail, " & 364 "justify = center, pad = a"); 365 end if; 366 end; 367 368 exception 369 when The_Error : others => 370 Report.Failed ("The following exception was raised in the " & 371 "Test_Block: " & Exception_Name(The_Error)); 372 end Test_Block; 373 374 Report.Result; 375 376end CXA4025; 377