1-- CXA4033.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_Unbounded, and Ada.Strings.Wide_Maps.Wide_Constants 29-- is available and produces correct results. 30-- 31-- TEST DESCRIPTION: 32-- This test tests the subprograms found in the 33-- Ada.Strings.Wide_Unbounded package. It is based on the tests 34-- CXA4030-32, which are tests for the complementary "non-wide" 35-- packages. 36-- 37-- The functions found in CXA4033_0 provide mapping capability, when 38-- used in conjunction with Wide_Character_Mapping_Function objects. 39-- 40-- 41-- CHANGE HISTORY: 42-- 23 Jun 95 SAIC Initial prerelease version. 43-- 24 Feb 97 PWB.CTA Removed attempt to create wide string of length 44-- Natural'Last 45--! 46 47package CXA4033_0 is 48 -- Functions used to supply mapping capability. 49 function Map_To_Lower_Case (From : Wide_Character) return Wide_Character; 50 function Map_To_Upper_Case (From : Wide_Character) return Wide_Character; 51end CXA4033_0; 52 53with Ada.Characters.Handling; 54package body CXA4033_0 is 55 -- Function Map_To_Lower_Case will return the lower case form of 56 -- Wide_Characters in the range 'A'..'Z' only, and return the input 57 -- wide_character otherwise. 58 59 function Map_To_Lower_Case (From : Wide_Character) 60 return Wide_Character is 61 begin 62 return Ada.Characters.Handling.To_Wide_Character( 63 Ada.Characters.Handling.To_Lower( 64 Ada.Characters.Handling.To_Character(From))); 65 end Map_To_Lower_Case; 66 67 -- Function Map_To_Upper_Case will return the upper case form of 68 -- Wide_Characters in the range 'a'..'z', or whose position is in one 69 -- of the ranges 223..246 or 248..255, provided the wide_character has 70 -- an upper case form. 71 72 function Map_To_Upper_Case (From : Wide_Character) 73 return Wide_Character is 74 begin 75 return Ada.Characters.Handling.To_Wide_Character( 76 Ada.Characters.Handling.To_Upper( 77 Ada.Characters.Handling.To_Character(From))); 78 end Map_To_Upper_Case; 79 80end CXA4033_0; 81 82 83with CXA4033_0; 84with Report; 85with Ada.Characters.Handling; 86with Ada.Characters.Latin_1; 87with Ada.Strings; 88with Ada.Strings.Wide_Maps; 89with Ada.Strings.Wide_Maps.Wide_Constants; 90with Ada.Strings.Wide_Fixed; 91with Ada.Strings.Wide_Unbounded; 92 93procedure CXA4033 is 94begin 95 Report.Test ("CXA4033", 96 "Check that subprograms defined in the package " & 97 "Ada.Strings.Wide_Unbounded produce correct results"); 98 99 Test_Block: 100 declare 101 102 package ACL1 renames Ada.Characters.Latin_1; 103 package Unb renames Ada.Strings.Wide_Unbounded; 104 105 subtype LC_Characters is Wide_Character range 'a'..'z'; 106 107 use Ada.Characters, Ada.Strings, Unb; 108 use type Wide_Maps.Wide_Character_Set; 109 110 TC_String : constant Wide_String := "A Standard String"; 111 112 String_20 : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; 113 String_40 : Wide_String(1..40) := "abcdefghijklmnopqrst" & 114 String_20; 115 String_80 : Wide_String(1..80) := String_40 & String_40; 116 TC_String_5 : Wide_String(1..5) := "ABCDE"; 117 TC_Unb_String : Unbounded_Wide_String := Null_Unbounded_Wide_String; 118 119 -- The following strings are used in examination of the Translation 120 -- subprograms. 121 New_Character_String : Wide_String(1..10) := 122 Handling.To_Wide_String( 123 ACL1.LC_A_Grave & ACL1.LC_A_Ring & ACL1.LC_AE_Diphthong & 124 ACL1.LC_C_Cedilla & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex & 125 ACL1.LC_Icelandic_Eth & ACL1.LC_N_Tilde & 126 ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn); 127 128 TC_New_Character_String : Wide_String(1..10) := 129 Handling.To_Wide_String( 130 ACL1.UC_A_Grave & ACL1.UC_A_Ring & ACL1.UC_AE_Diphthong & 131 ACL1.UC_C_Cedilla & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex & 132 ACL1.UC_Icelandic_Eth & ACL1.UC_N_Tilde & 133 ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn); 134 135 New_UB_Character_String : Unbounded_Wide_String := 136 To_Unbounded_Wide_String(New_Character_String); 137 138 TC_New_UB_Character_String : Unbounded_Wide_String := 139 To_Unbounded_Wide_String(TC_New_Character_String); 140 141 -- Access objects that will be provided as parameters to the 142 -- subprograms. 143 Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := 144 CXA4033_0.Map_To_Lower_Case'Access; 145 Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := 146 CXA4033_0.Map_To_Upper_Case'Access; 147 148 begin 149 150 -- Testing functionality found in Package Ada.Strings.Wide_Unbounded. 151 -- 152 -- Function Index. 153 154 if Index(To_Unbounded_Wide_String("AAABBBaaabbb"), 155 "aabb", 156 Mapping => Map_To_Lower_Case_Ptr) /= 2 or 157 Index(To_Unbounded_Wide_String("Case of a Mixed Case String"), 158 "case", 159 Ada.Strings.Backward, 160 Map_To_Lower_Case_Ptr) /= 17 161 then 162 Report.Failed("Incorrect results from Function Index, " & 163 "using a Wide Character Mapping Function parameter"); 164 end if; 165 166 -- Function Count. 167 if Count(Source => To_Unbounded_Wide_String("ABABABA"), 168 Pattern => "aba", 169 Mapping => Map_To_Lower_Case_Ptr) /= 2 or 170 Count(Null_Unbounded_Wide_String, "mat", Map_To_Upper_Case_Ptr) /= 0 171 then 172 Report.Failed("Incorrect results from Function Count, using " & 173 "a Character Mapping Function parameter"); 174 end if; 175 176 -- Function Translate. 177 if Translate(To_Unbounded_Wide_String("A Sample Mixed Case String"), 178 Mapping => Map_To_Lower_Case_Ptr) /= 179 To_Unbounded_Wide_String("a sample mixed case string") or 180 Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr) /= 181 TC_New_UB_Character_String 182 then 183 Report.Failed("Incorrect results from Function Translate, " & 184 "using a Character Mapping Function parameter"); 185 end if; 186 187 -- Procedure Translate. 188 declare 189 use Ada.Characters.Handling; 190 Str : Unbounded_Wide_String := 191 To_Unbounded_Wide_String("AN ALL UPPER CASE STRING"); 192 begin 193 Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr); 194 if Str /= To_Unbounded_Wide_String("an all upper case string") then 195 Report.Failed("Incorrect result from Procedure Translate 1"); 196 end if; 197 198 Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr); 199 if New_UB_Character_String /= TC_New_UB_Character_String then 200 Report.Failed("Incorrect result from Procedure Translate 2"); 201 end if; 202 end; 203 204 -- Function To_Unbounded_Wide_String (version with Length parameter) 205 if Length(To_Unbounded_Wide_String(Length => 10)) /= 10 or 206 Length(To_Unbounded_Wide_String(0)) /= 0 or 207 Length( To_Unbounded_Wide_String(10) & 208 To_Unbounded_Wide_String(1) & 209 To_Unbounded_Wide_String(0) ) /= 10 + 1 + 0 210 then 211 Report.Failed 212 ("Incorrect results from Function To_Unbounded_Wide_String " & 213 "with Length parameter"); 214 end if; 215 216 -- Procedure Append (Wide_Unbounded - Wide_Unbounded) 217 TC_Unb_String := Null_Unbounded_Wide_String; 218 Append(TC_Unb_String, To_Unbounded_Wide_String("New Unbounded String")); 219 if TC_Unb_String /= To_Unbounded_Wide_String("New Unbounded String") 220 then 221 Report.Failed("Incorrect results from Procedure Append with " & 222 "unbounded wide string parameters"); 223 end if; 224 225 226 -- Procedure Append (Wide_Unbounded - Wide_String) 227 TC_Unb_String := To_Unbounded_Wide_String("An Unbounded String and "); 228 Append(Source => TC_Unb_String, New_Item => TC_String); 229 if TC_Unb_String /= 230 To_Unbounded_Wide_String("An Unbounded String and A Standard String") 231 then 232 Report.Failed("Incorrect results from Procedure Append with " & 233 "an unbounded wide string parameter and a wide " & 234 "string parameter"); 235 end if; 236 237 -- Procedure Append (Wide_Unbounded - Wide_Character) 238 TC_Unb_String := To_Unbounded_Wide_String("Lower Case = "); 239 for i in LC_Characters'Range loop 240 Append(Source => TC_Unb_String, New_Item => LC_Characters(i)); 241 end loop; 242 if TC_Unb_String /= 243 Unb.To_Unbounded_Wide_String 244 ("Lower Case = abcdefghijklmnopqrstuvwxyz") 245 then 246 Report.Failed("Incorrect results from Procedure Append with " & 247 "an unbounded wide string parameter and a wide " & 248 "character parameter"); 249 end if; 250 251 -- Function "=" 252 TC_Unb_String := To_Unbounded_Wide_String(TC_String); 253 if not (TC_Unb_String = TC_String) or 254 not "="("A Standard String", TC_Unb_String) or 255 not ((Null_Unbounded_Wide_String = "") and 256 ("Test String" = To_Unbounded_Wide_String("Test String"))) 257 then 258 Report.Failed("Incorrect results from Function ""="" with " & 259 "wide_string - unbounded wide string parameters"); 260 end if; 261 262 -- Function "<" 263 if not ("Extra Space" < To_Unbounded_Wide_String("Extra Space ") and 264 To_Unbounded_Wide_String("tess") < "test" and 265 To_Unbounded_Wide_String("best") < "test") 266 then 267 Report.Failed("Incorrect results from Function ""<"" with " & 268 "wide string - unbounded wide string parameters"); 269 end if; 270 271 -- Function "<=" 272 TC_Unb_String := To_Unbounded_Wide_String("Sample string"); 273 if TC_Unb_String <= "Sample strin" or 274 not("Sample string" <= TC_Unb_String) 275 then 276 Report.Failed("Incorrect results from Function ""<="" with " & 277 "wide string - unbounded wide string parameters"); 278 end if; 279 280 -- Function ">" 281 TC_Unb_String := To_Unbounded_Wide_String("A MUCH LONGER STRING"); 282 if not ("A much longer string" > TC_Unb_String and 283 To_Unbounded_Wide_String(TC_String) > "A Standard Strin" and 284 "abcdefgh" > To_Unbounded_Wide_String("ABCDEFGH")) 285 then 286 Report.Failed("Incorrect results from Function "">"" with " & 287 "wide string - unbounded wide string parameters"); 288 end if; 289 290 -- Function ">=" 291 TC_Unb_String := To_Unbounded_Wide_String(TC_String); 292 if not (TC_Unb_String >= TC_String and 293 "test" >= To_Unbounded_Wide_String("tess") and 294 To_Unbounded_Wide_String("Programming") >= "PROGRAMMING") 295 then 296 Report.Failed("Incorrect results from Function "">="" with " & 297 "wide string - unbounded wide string parameters"); 298 end if; 299 300 -- Procedure Replace_Slice 301 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 302 Replace_Slice(TC_Unb_String, 5, 5, TC_String_5); 303 if TC_Unb_String /= To_Unbounded_Wide_String("TestABCDEString") then 304 Report.Failed("Incorrect results from Replace_Slice - 1"); 305 end if; 306 307 Replace_Slice(TC_Unb_String, 1, 4, TC_String_5); 308 if TC_Unb_String /= To_Unbounded_Wide_String("ABCDEABCDEString") then 309 Report.Failed("Incorrect results from Replace_Slice - 2"); 310 end if; 311 312 -- Procedure Insert 313 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 314 Insert(TC_Unb_String, 1, "**"); 315 if TC_Unb_String /= To_Unbounded_Wide_String("**Test String") then 316 Report.Failed("Incorrect results from Procedure Insert - 1"); 317 end if; 318 319 Insert(TC_Unb_String, Length(TC_Unb_String)+1, "**"); 320 if TC_Unb_String /= To_Unbounded_Wide_String("**Test String**") then 321 Report.Failed("Incorrect results from Procedure Insert - 2"); 322 end if; 323 324 -- Procedure Overwrite 325 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 326 Overwrite(TC_Unb_String, 1, New_Item => "XXXX"); 327 if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String") then 328 Report.Failed("Incorrect results from Procedure Overwrite - 1"); 329 end if; 330 331 Overwrite(TC_Unb_String, Length(TC_Unb_String)+1, "**"); 332 if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String**") then 333 Report.Failed("Incorrect results from Procedure Overwrite - 2"); 334 end if; 335 336 -- Procedure Delete 337 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 338 Delete(TC_Unb_String, 1, 0); 339 if TC_Unb_String /= To_Unbounded_Wide_String("Test String") then 340 Report.Failed("Incorrect results from Procedure Delete - 1"); 341 end if; 342 343 Delete(TC_Unb_String, 1, 5); 344 if TC_Unb_String /= To_Unbounded_Wide_String("String") then 345 Report.Failed("Incorrect results from Procedure Delete - 2"); 346 end if; 347 348 -- Procedure Trim 349 TC_Unb_String := To_Unbounded_Wide_String(" Leading Spaces "); 350 Trim(TC_Unb_String, Ada.Strings.Left); 351 if TC_Unb_String /= To_Unbounded_Wide_String("Leading Spaces ") then 352 Report.Failed("Incorrect results from Procedure Trim - 1"); 353 end if; 354 355 TC_Unb_String := 356 To_Unbounded_Wide_String(" Spaces on both ends "); 357 Trim(TC_Unb_String, Ada.Strings.Both); 358 if TC_Unb_String /= 359 To_Unbounded_Wide_String("Spaces on both ends") 360 then 361 Report.Failed("Incorrect results from Procedure Trim - 2"); 362 end if; 363 364 -- Procedure Trim (with Wide_Character_Set parameters) 365 TC_Unb_String := To_Unbounded_Wide_String("012abcdefghGFEDCBA789ab"); 366 Trim(TC_Unb_String, 367 Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set, 368 Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set); 369 if TC_Unb_String /= To_Unbounded_Wide_String("ghG") then 370 Report.Failed("Incorrect results from Procedure Trim with Sets"); 371 end if; 372 373 -- Procedure Head 374 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 375 Head(Source => TC_Unb_String, Count => 0, Pad => '*'); 376 if TC_Unb_String /= Null_Unbounded_Wide_String then 377 Report.Failed("Incorrect results from Procedure Head - 1"); 378 end if; 379 380 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 381 Head(Source => TC_Unb_String, Count => 4, Pad => '*'); 382 if TC_Unb_String /= To_Unbounded_Wide_String("Test") then 383 Report.Failed("Incorrect results from Procedure Head - 2"); 384 end if; 385 386 -- Procedure Tail 387 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 388 Tail(Source => TC_Unb_String, Count => 0, Pad => '*'); 389 if TC_Unb_String /= Null_Unbounded_Wide_String then 390 Report.Failed("Incorrect results from Procedure Tail - 1"); 391 end if; 392 393 TC_Unb_String := To_Unbounded_Wide_String("Test String"); 394 Tail(TC_Unb_String, Length(TC_Unb_String) + 5, 'x'); 395 if TC_Unb_String /= To_Unbounded_Wide_String("xxxxxTest String") then 396 Report.Failed("Incorrect results from Procedure Tail - 2"); 397 end if; 398 399 exception 400 when others => Report.Failed ("Exception raised in Test_Block"); 401 end Test_Block; 402 403 Report.Result; 404 405end CXA4033; 406