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_Bounded, and Ada.Strings.Wide_Maps.Wide_Constants
29 -- is available and produces correct results.
32 -- This test tests the subprograms found in the
33 -- Ada.Strings.Wide_Bounded package. It is based on the tests
34 -- CXA4027-28, which are tests for the complementary "non-wide"
37 -- The functions found in CXA4029_0 provide mapping capability, when
38 -- used in conjunction with Wide_Character_Mapping_Function objects.
42 -- 23 Jun 95 SAIC Initial prerelease version.
43 -- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1.
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;
53 with Ada
.Characters
.Handling
;
54 package body CXA4029_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.
59 function Map_To_Lower_Case
(From
: Wide_Character)
60 return Wide_Character is
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
;
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.
72 function Map_To_Upper_Case
(From
: Wide_Character)
73 return Wide_Character is
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
;
85 with Ada
.Characters
.Handling
;
86 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
;
91 with Ada
.Strings
.Wide_Bounded
;
95 Report
.Test
("CXA4029",
96 "Check that subprograms defined in package " &
97 "Ada.Strings.Wide_Bounded produce correct results");
102 package ACL1
renames Ada
.Characters
.Latin_1
;
103 package BS1
is new Ada
.Strings
.Wide_Bounded
.Generic_Bounded_Length
(1);
104 package BS20
is new Ada
.Strings
.Wide_Bounded
.Generic_Bounded_Length
(20);
105 package BS40
is new Ada
.Strings
.Wide_Bounded
.Generic_Bounded_Length
(40);
106 package BS80
is new Ada
.Strings
.Wide_Bounded
.Generic_Bounded_Length
(80);
108 subtype LC_Characters
is Wide_Character range 'a'..'z';
110 use Ada
.Characters
, Ada
.Strings
;
111 use type Wide_Maps
.Wide_Character_Set
;
112 use type BS1
.Bounded_Wide_String
, BS20
.Bounded_Wide_String
,
113 BS40
.Bounded_Wide_String
, BS80
.Bounded_Wide_String
;
115 TC_String
: constant Wide_String := "A Standard String";
117 BString_1
: BS1
.Bounded_Wide_String
:=
118 BS1
.Null_Bounded_Wide_String
;
119 BString_20
: BS20
.Bounded_Wide_String
:=
120 BS20
.Null_Bounded_Wide_String
;
121 BString_40
: BS40
.Bounded_Wide_String
:=
122 BS40
.Null_Bounded_Wide_String
;
123 BString_80
: BS80
.Bounded_Wide_String
:=
124 BS80
.Null_Bounded_Wide_String
;
125 String_20
: Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST";
126 String_40
: Wide_String(1..40) := "abcdefghijklmnopqrst" &
128 String_80
: Wide_String(1..80) := String_40
& String_40
;
129 TC_String_5
: Wide_String(1..5) := "ABCDE";
131 -- The following strings are used in examination of the Translation
133 New_Character_String
: Wide_String(1..10) :=
134 Handling
.To_Wide_String
(
135 ACL1
.LC_A_Grave
& ACL1
.LC_A_Ring
& ACL1
.LC_AE_Diphthong
&
136 ACL1
.LC_C_Cedilla
& ACL1
.LC_E_Acute
& ACL1
.LC_I_Circumflex
&
137 ACL1
.LC_Icelandic_Eth
& ACL1
.LC_N_Tilde
&
138 ACL1
.LC_O_Oblique_Stroke
& ACL1
.LC_Icelandic_Thorn
);
140 TC_New_Character_String
: Wide_String(1..10) :=
141 Handling
.To_Wide_String
(
142 ACL1
.UC_A_Grave
& ACL1
.UC_A_Ring
& ACL1
.UC_AE_Diphthong
&
143 ACL1
.UC_C_Cedilla
& ACL1
.UC_E_Acute
& ACL1
.UC_I_Circumflex
&
144 ACL1
.UC_Icelandic_Eth
& ACL1
.UC_N_Tilde
&
145 ACL1
.UC_O_Oblique_Stroke
& ACL1
.UC_Icelandic_Thorn
);
147 -- Access objects that will be provided as parameters to the
149 Map_To_Lower_Case_Ptr
: Wide_Maps
.Wide_Character_Mapping_Function
:=
150 CXA4029_0
.Map_To_Lower_Case
'Access;
151 Map_To_Upper_Case_Ptr
: Wide_Maps
.Wide_Character_Mapping_Function
:=
152 CXA4029_0
.Map_To_Upper_Case
'Access;
156 -- Testing of functionality found in Package Ada.Strings.Wide_Bounded.
160 if BS80
.Index
(BS80
.To_Bounded_Wide_String
("CoMpLeTeLy MiXeD CaSe"),
163 Map_To_Upper_Case_Ptr
) /= 12 or
164 BS1
.Index
(BS1
.Null_Bounded_Wide_String
,
166 Mapping
=> Map_To_Lower_Case_Ptr
) /= 0
168 Report
.Failed
("Incorrect results from BND Function Index, going " &
169 "in Forward direction, using a Character Mapping " &
170 "Function parameter");
174 if BS40
.Count
(BS40
.To_Bounded_Wide_String
("This IS a MISmatched issue"),
176 Map_To_Lower_Case_Ptr
) /= 4 or
177 BS80
.Count
(BS80
.To_Bounded_Wide_String
("ABABABA"),
179 Map_To_Upper_Case_Ptr
) /= 2
181 Report
.Failed
("Incorrect results from BND Function Count, using " &
182 "a Character_Mapping_Function parameter");
185 -- Function Translate.
186 if BS40
.Translate
(BS40
.To_Bounded_Wide_String
("A Mixed Case String"),
187 Mapping
=> Map_To_Lower_Case_Ptr
) /=
188 BS40
.To_Bounded_Wide_String
("a mixed case string") or
189 BS20
."/="("end with lower case",
191 BS20
.To_Bounded_Wide_String
("end with lower case"),
192 Map_To_Lower_Case_Ptr
))
194 Report
.Failed
("Incorrect results from BND Function Translate, " &
195 "using a Character_Mapping_Function parameter");
198 -- Procedure Translate.
199 BString_20
:= BS20
.To_Bounded_Wide_String
(String_20
);
200 BS20
.Translate
(BString_20
, Mapping
=> Map_To_Lower_Case_Ptr
);
201 if BString_20
/= BS20
.To_Bounded_Wide_String
("abcdefghijklmnopqrst")
203 Report
.Failed
("Incorrect result from BND Procedure Translate - 1");
206 BString_80
:= BS80
.Null_Bounded_Wide_String
;
207 BS80
.Translate
(BString_80
, Map_To_Upper_Case_Ptr
);
208 if not (BString_80
= BS80
.Null_Bounded_Wide_String
) then
209 Report
.Failed
("Incorrect result from BND Procedure Translate - 2");
216 BString_20
:= BS20
.Null_Bounded_Wide_String
;
217 Append
(BString_20
, 'T');
218 Append
(BString_20
, "his string");
220 To_Bounded_Wide_String
(" is complete."),
221 Drop
=> Ada
.Strings
.Right
); -- Drop 4 characters.
222 if BString_20
/= To_Bounded_Wide_String
("This string is compl") then
223 Report
.Failed
("Incorrect results from BS20 versions of " &
227 when others => Report
.Failed
("Exception raised in block checking " &
228 "BND Procedure Append");
232 BString_40
:= BS40
.To_Bounded_Wide_String
(String_40
);
233 BString_80
:= BS80
.To_Bounded_Wide_String
(
234 BS40
.To_Wide_String
(BString_40
) &
235 BS40
.To_Wide_String
(BString_40
));
236 if not (BString_40
= String_40
and
237 BS80
."="(String_80
, BString_80
)) then
238 Report
.Failed
("Incorrect results from BND Function ""="" with " &
239 "string - bounded string parameter combinations");
243 BString_1
:= BS1
.To_Bounded_Wide_String
("cat",
244 Drop
=> Ada
.Strings
.Right
);
245 BString_20
:= BS20
.To_Bounded_Wide_String
("Santa Claus");
246 if BString_1
< "C" or
247 BS1
."<"(BString_1
,"c") or
248 BS1
."<"("x", BString_1
) or
249 BS20
."<"(BString_20
,"Santa ") or
250 BS20
."<"("Santa and his Elves", BString_20
)
252 Report
.Failed
("Incorrect results from BND Function ""<"" with " &
253 "string - bounded string parameter combinations");
257 BString_20
:= BS20
.To_Bounded_Wide_String
("Sample string");
258 if BS20
."<="(BString_20
,"Sample strin") or
259 not(BS20
."<="("Sample string",BString_20
))
261 Report
.Failed
("Incorrect results from BND Function ""<="" with " &
262 "string - bounded string parameter combinations");
266 BString_40
:= BS40
.To_Bounded_Wide_String
(
267 "A MUCH LONGER SAMPLE STRING.");
268 if BString_40
> "A much longer sample string" or
269 BS40
.To_Bounded_Wide_String
("ABCDEFGH") > "abcdefgh"
271 Report
.Failed
("Incorrect results from BND Function "">"" with " &
272 "string - bounded string parameter combinations");
276 BString_80
:= BS80
.To_Bounded_Wide_String
(String_80
);
277 if not (BString_80
>= String_80
and
278 BS80
.To_Bounded_Wide_String
("Programming") >= "PROGRAMMING" and
279 BS80
.">="("test", BS80
.To_Bounded_Wide_String
("tess")))
281 Report
.Failed
("Incorrect results from BND Function "">="" with " &
282 "string - bounded string parameter combinations");
286 BString_20
:= BS20
.To_Bounded_Wide_String
(" Both Sides ");
287 BS20
.Trim
(BString_20
, Ada
.Strings
.Both
);
288 if BString_20
/= BS20
.To_Bounded_Wide_String
("Both Sides") then
289 Report
.Failed
("Incorrect results from BND Procedure Trim with " &
294 BString_40
:= BS40
.To_Bounded_Wide_String
("Test String");
295 BS40
.Head
(Source
=> BString_40
,
296 Count
=> 4); -- Count < Source'Length
297 if BString_40
/= BS40
.To_Bounded_Wide_String
("Test") then
298 Report
.Failed
("Incorrect results from BND Procedure Head with " &
299 "the Count parameter less than Source'Length");
302 BString_20
:= BS20
.To_Bounded_Wide_String
("Short String");
303 BS20
.Head
(BString_20
, 23, '-', Ada
.Strings
.Right
);
304 if BS20
.To_Bounded_Wide_String
("Short String--------") /= BString_20
then
305 Report
.Failed
("Incorrect results from BND Procedure Head with " &
306 "the Count parameter greater than Source'Length, " &
307 "and the Drop parameter = Right");
311 BString_40
:= BS40
.To_Bounded_Wide_String
("Test String");
312 BS40
.Tail
(Source
=> BString_40
,
314 if BString_40
/= BS40
.To_Bounded_Wide_String
("String") then
315 Report
.Failed
("Incorrect results from BND Procedure Tail with " &
316 "the Count parameter less than Source'Length");
319 BString_20
:= BS20
.To_Bounded_Wide_String
("Maximum Length Chars");
320 BS20
.Tail
(BString_20
, 23, '-', Ada
.Strings
.Right
);
321 if BS20
.To_Bounded_Wide_String
("---Maximum Length Ch") /= BString_20
then
322 Report
.Failed
("Incorrect results from BND Procedure Tail with " &
323 "the Count parameter greater than Source'Length, " &
324 "and the Drop parameter = Right");
328 when others => Report
.Failed
("Exception raised in Test_Block");