3 -- Grant of Unlimited Rights
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
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.
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.
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.
36 -- The functions found in CXA4025_0 provide mapping capability, when
37 -- used in conjunction with Wide_Character_Mapping_Function objects.
41 -- 23 Jun 95 SAIC Initial prerelease version.
42 -- 15 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1.
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;
52 with Ada
.Characters
.Handling
;
53 package 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.
58 function Map_To_Lower_Case
(From
: Wide_Character)
59 return Wide_Character is
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
;
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.
71 function Map_To_Upper_Case
(From
: Wide_Character)
72 return Wide_Character is
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
;
84 with Ada
.Characters
.Handling
;
85 with Ada
.Characters
.Latin_1
;
88 with Ada
.Strings
.Wide_Maps
;
89 with Ada
.Strings
.Wide_Maps
.Wide_Constants
;
90 with Ada
.Strings
.Wide_Fixed
;
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");
102 package ACL1
renames Ada
.Characters
.Latin_1
;
104 use Ada
.Characters
, Ada
.Strings
;
106 use type Wide_Maps
.Wide_Character_Set
;
108 subtype LC_Characters
is Wide_Character range 'a'..'z';
110 Last_Letter
: constant := 26;
111 Vowels
: constant Wide_Maps
.Wide_Character_Sequence
:= "aeiou";
112 TC_String
: constant Wide_String := "A Standard String";
114 Alphabet
: Wide_Maps
.Wide_Character_Sequence
(1..Last_Letter
);
117 Vowel_Set
: Wide_Maps
.Wide_Character_Set
;
119 String_20
: Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST";
120 String_40
: Wide_String(1..40) := "abcdefghijklmnopqrst" &
122 String_80
: Wide_String(1..80) := String_40
& String_40
;
123 TC_String_5
: Wide_String(1..5) := "ABCDE";
125 -- The following strings are used in examination of the Translation
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
);
135 -- Note that there is no upper case version of the last two
136 -- characters from above.
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
);
146 -- Access objects that will be provided as parameters to the
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;
156 -- Testing of functionality found in Package Ada.Strings.Wide_Maps.
159 -- Load the alphabet strings for use in creating sets.
161 Alphabet
(i
+1) := Wide_Character'Val(Wide_Character'Pos('a')+i
);
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
;
169 -- Evaluation of Set operator "-".
171 (Alphabet_Set
- Consonant_Set
) /=
172 "AND"(Alphabet_Set
, "NOT"(Consonant_Set
)) or
173 (Alphabet_Set
- Vowel_Set
) /= "AND"(Alphabet_Set
, "NOT"(Vowel_Set
))
175 Report
.Failed
("Incorrect result from ""-"" operator for sets");
178 -- Evaluation of Functions To_Domain and To_Range.
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
,
188 TC_Lower_to_Upper_Map
: Wide_Maps
.Wide_Character_Mapping
:=
189 Wide_Maps
.To_Mapping
(TC_LC_Sequence
,
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
);
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
202 if TC_Domain
/= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
203 Report
.Failed
("Incorrect result from To_Domain with " &
204 "TC_Upper_to_Lower_Map as input");
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");
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");
219 -- The lower bound on the returned Character_Sequence value
221 if TC_Range
'First /= 1 then
222 Report
.Failed
("Incorrect lower bound returned from To_Range");
225 if TC_Range
'Last /= TC_LC_Sequence
'Length then
226 Report
.Failed
("Incorrect upper bound returned from To_Range");
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
235 Report
.Failed
("Null sequence not returned from To_Domain or " &
236 "To_Range when provided the Identity map as input");
240 Report
.Failed
("Exception raised during the evaluation of " &
241 "Function To_Domain and To_Range");
244 -- Testing of functionality found in Package Ada.Strings.Wide_Fixed.
246 -- Function Index, Forward direction search.
248 if Wide_Fixed
.Index
("CoMpLeTeLy MiXeD CaSe StRiNg",
251 Map_To_Upper_Case_Ptr
) /= 12 or
252 Wide_Fixed
.Index
("STRING WITH NO MATCHING PATTERNS",
255 Map_To_Lower_Case_Ptr
) /= 0
257 Report
.Failed
("Incorrect results from Function Index, going " &
258 "in Forward direction, using a Character Mapping " &
259 "Function parameter");
262 -- Function Index, Backward direction search.
263 if Wide_Fixed
.Index
("Case of a Mixed Case String",
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
272 Report
.Failed
("Incorrect results from Function Index, going " &
273 "in Backward direction, using a Character Mapping " &
274 "Function parameter");
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
281 Report
.Failed
("Incorrect results from Function Count, using " &
282 "a Character Mapping Function parameter");
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
293 Report
.Failed
("Incorrect results from Function Translate, using " &
294 "a Wide_Character Mapping Function parameter");
297 -- Procedure Translate.
299 use Ada
.Strings
.Wide_Fixed
;
300 Str
: Wide_String(1..19) := "A Mixed Case String";
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");
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");
315 use Ada
.Strings
.Wide_Fixed
;
316 Trim_String
: Wide_String(1..30) := " A string of characters ";
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");
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");
333 Fixed_String
: Wide_String(1..20) := "A sample test string";
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 = $");
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");
351 use Ada
.Strings
.Wide_Fixed
;
352 Tail_String
: Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST";
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 = -");
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");
369 when The_Error
: others =>
370 Report
.Failed
("The following exception was raised in the " &
371 "Test_Block: " & Exception_Name
(The_Error
));