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 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
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.
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.
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.
55 -- Results of all subprograms are compared with expected results.
59 -- 10 Feb 95 SAIC Initial prerelease version
60 -- 21 Apr 95 SAIC Modified definition of string variable Str_2.
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.
71 function Map_To_Lower_Case
(From
: Character) return Character;
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.
79 function Map_To_Upper_Case
(From
: Character) return Character;
84 with Ada
.Characters
.Handling
;
85 package body CXA4026_0
is
87 function Map_To_Lower_Case
(From
: Character) return Character is
89 if From
in 'A'..'Z' then
90 return Character'Val(Character'Pos(From
) -
91 (Character'Pos('A') - Character'Pos('a')));
95 end Map_To_Lower_Case
;
97 function Map_To_Upper_Case
(From
: Character) return Character is
99 return Ada
.Characters
.Handling
.To_Upper
(From
);
100 end Map_To_Upper_Case
;
106 with Ada
.Strings
.Fixed
;
107 with Ada
.Strings
.Maps
;
108 with Ada
.Characters
.Handling
;
109 with Ada
.Characters
.Latin_1
;
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");
125 use Ada
.Strings
, CXA4026_0
;
127 -- The following strings are used in examination of the Translation
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
;
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
;
156 -- Functions used to supply mapping capability.
159 -- Access objects that will be provided as parameters to the
162 Map_To_Lower_Case_Ptr
: Maps
.Character_Mapping_Function
:=
163 Map_To_Lower_Case
'Access;
165 Map_To_Upper_Case_Ptr
: Maps
.Character_Mapping_Function
:=
166 Map_To_Upper_Case
'Access;
171 -- Function Index, Forward direction search.
172 -- Note: Several of the following cases use the default value
173 -- Forward for the Going parameter.
175 if Fixed
.Index
(Source
=> "The library package Strings.Fixed",
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",
181 Mapping
=> Map_To_Lower_Case_Ptr
) /= 6 or
182 Fixed
.Index
("maximum number",
185 Map_To_Lower_Case_Ptr
) /= 6 or
186 Fixed
.Index
("CoMpLeTeLy MiXeD CaSe StRiNg",
189 Map_To_Upper_Case_Ptr
) /= 12 or
190 Fixed
.Index
("STRING WITH NO MATCHING PATTERNS",
193 Map_To_Lower_Case_Ptr
) /= 0 or
194 Fixed
.Index
("THIS STRING IS IN UPPER CASE",
197 Map_To_Upper_Case_Ptr
) /= 3 or
198 Fixed
.Index
("", -- Null string.
200 Mapping
=> Map_To_Lower_Case_Ptr
) /= 0 or
201 Fixed
.Index
("AAABBBaaabbb",
203 Mapping
=> Map_To_Lower_Case_Ptr
) /= 2
205 Report
.Failed
("Incorrect results from Function Index, going " &
206 "in Forward direction, using a Character Mapping " &
207 "Function parameter");
212 -- Function Index, Backward direction search.
214 if Fixed
.Index
("Case of a Mixed Case String",
216 Ada
.Strings
.Backward
,
217 Map_To_Lower_Case_Ptr
) /= 17 or
218 Fixed
.Index
("Case of a Mixed Case String",
220 Ada
.Strings
.Backward
,
221 Map_To_Upper_Case_Ptr
) /= 17 or
222 Fixed
.Index
("rain, Rain, and more RAIN",
224 Ada
.Strings
.Backward
,
225 Map_To_Lower_Case_Ptr
) /= 22 or
226 Fixed
.Index
("RIGHT place, right time",
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
235 Report
.Failed
("Incorrect results from Function Index, going " &
236 "in Backward direction, using a Character Mapping " &
237 "Function parameter");
242 -- Function Index, Pattern_Error if Pattern = Null_String
245 use Ada
.Strings
.Fixed
;
246 Null_Pattern_String
: constant String := "";
247 TC_Natural
: Natural := 1000;
249 TC_Natural
:= Index
("A Valid String",
252 Map_To_Lower_Case_Ptr
);
253 Report
.Failed
("Pattern_Error not raised by Function Index when " &
254 "given a null pattern string");
256 when Pattern_Error
=> null; -- OK, expected exception.
258 Report
.Failed
("Incorrect exception raised by Function Index " &
259 "using a Character Mapping Function parameter " &
260 "when given a null pattern string");
267 if Fixed
.Count
(Source
=> "ABABABA",
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",
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",
277 Map_To_Upper_Case_Ptr
) /= 0 or
278 Fixed
.Count
("She sells sea shells by the sea shore",
280 Map_To_Lower_Case_Ptr
) /= 8 or
281 Fixed
.Count
("", -- Null string.
283 Map_To_Upper_Case_Ptr
) /= 0
285 Report
.Failed
("Incorrect results from Function Count, using " &
286 "a Character Mapping Function parameter");
291 -- Function Count, Pattern_Error if Pattern = Null_String
294 use Ada
.Strings
.Fixed
;
295 Null_Pattern_String
: constant String := "";
296 TC_Natural
: Natural := 1000;
298 TC_Natural
:= Count
("A Valid 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");
305 when Pattern_Error
=> null; -- OK, expected exception.
307 Report
.Failed
("Incorrect exception raised by Function Count " &
308 "using a Character Mapping Function parameter " &
309 "when given a null pattern string");
314 -- Function Translate.
316 if Fixed
.Translate
(Source
=> "A Sample Mixed Case String",
317 Mapping
=> Map_To_Lower_Case_Ptr
) /=
318 "a sample mixed case string" or
320 Fixed
.Translate
("ALL LOWER CASE",
321 Map_To_Lower_Case_Ptr
) /=
324 Fixed
.Translate
("end with lower case",
325 Map_To_Lower_Case_Ptr
) /=
326 "end with lower case" or
328 Fixed
.Translate
("", Map_To_Lower_Case_Ptr
) /=
331 Fixed
.Translate
("start with lower case",
332 Map_To_Upper_Case_Ptr
) /=
333 "START WITH LOWER CASE" or
335 Fixed
.Translate
("ALL UPPER CASE STRING",
336 Map_To_Upper_Case_Ptr
) /=
337 "ALL UPPER CASE STRING" or
339 Fixed
.Translate
("LoTs Of MiXeD CaSe ChArAcTeRs",
340 Map_To_Upper_Case_Ptr
) /=
341 "LOTS OF MIXED CASE CHARACTERS" or
343 Fixed
.Translate
("", Map_To_Upper_Case_Ptr
) /=
346 Fixed
.Translate
(New_Character_String
,
347 Map_To_Upper_Case_Ptr
) /=
348 TC_New_Character_String
350 Report
.Failed
("Incorrect results from Function Translate, using " &
351 "a Character Mapping Function parameter");
356 -- Procedure Translate.
360 use Ada
.Strings
.Fixed
;
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
;
370 Translate
(Source
=> Str_1
, Mapping
=> Map_To_Lower_Case_Ptr
);
372 if Str_1
/= "an all upper case string" then
373 Report
.Failed
("Incorrect result from Procedure Translate - 1");
376 Translate
(Source
=> Str_1
, Mapping
=> Map_To_Upper_Case_Ptr
);
378 if Str_1
/= TC_Str_1
then
379 Report
.Failed
("Incorrect result from Procedure Translate - 2");
382 Translate
(Source
=> Str_2
, Mapping
=> Map_To_Lower_Case_Ptr
);
384 if Str_2
/= "a mixed case string" then
385 Report
.Failed
("Incorrect result from Procedure Translate - 3");
388 Translate
(Source
=> Str_2
, Mapping
=> Map_To_Upper_Case_Ptr
);
390 if Str_2
/= "A MIXED CASE STRING" then
391 Report
.Failed
("Incorrect result from Procedure Translate - 4");
394 Translate
(Source
=> Str_3
, Mapping
=> Map_To_Lower_Case_Ptr
);
396 if Str_3
/= TC_Str_3
then
397 Report
.Failed
("Incorrect result from Procedure Translate - 5");
400 Translate
(Source
=> Str_3
, Mapping
=> Map_To_Upper_Case_Ptr
);
402 if Str_3
/= "A STRING WITH LOWER CASE LETTERS" then
403 Report
.Failed
("Incorrect result from Procedure Translate - 6");
406 Translate
(New_Character_String
, Map_To_Upper_Case_Ptr
);
408 if New_Character_String
/= TC_New_Character_String
then
409 Report
.Failed
("Incorrect result from Procedure Translate - 6");
418 Use Ada
.Strings
.Fixed
;
419 Trim_String
: String(1..30) := " A string of characters ";
422 Trim
(Source
=> Trim_String
,
423 Side
=> Ada
.Strings
.Left
,
424 Justify
=> Ada
.Strings
.Right
,
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");
432 Trim
(Trim_String
, Ada
.Strings
.Right
, Ada
.Strings
.Center
);
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");
439 Trim
(Trim_String
, Ada
.Strings
.Both
, Pad
=> '*');
441 if Trim_String
/= "xxxxA string of characters****" then
442 Report
.Failed
("Incorrect result from Procedure Trim, trim " &
443 "side = both, default justify, pad = *");
452 Fixed_String
: String(1..20) := "A sample test string";
455 Fixed
.Head
(Source
=> Fixed_String
,
457 Justify
=> Ada
.Strings
.Center
,
460 if Fixed_String
/= "$$$A sample test $$$" then
461 Report
.Failed
("Incorrect result from Procedure Head, " &
462 "justify = center, pad = $");
465 Fixed
.Head
(Fixed_String
, 11, Ada
.Strings
.Right
);
467 if Fixed_String
/= " $$$A sample" then
468 Report
.Failed
("Incorrect result from Procedure Head, " &
469 "justify = right, default pad");
472 Fixed
.Head
(Fixed_String
, 9, Pad
=> '*');
474 if Fixed_String
/= " ***********" then
475 Report
.Failed
("Incorrect result from Procedure Head, " &
476 "default justify, pad = *");
485 Use Ada
.Strings
.Fixed
;
486 Tail_String
: String(1..20) := "ABCDEFGHIJKLMNOPQRST";
489 Tail
(Source
=> Tail_String
, Count
=> 10, Pad
=> '-');
491 if Tail_String
/= "KLMNOPQRST----------" then
492 Report
.Failed
("Incorrect result from Procedure Tail, " &
493 "default justify, pad = -");
496 Tail
(Tail_String
, 6, Justify
=> Ada
.Strings
.Center
, Pad
=> 'a');
498 if Tail_String
/= "aaaaaaa------aaaaaaa" then
499 Report
.Failed
("Incorrect result from Procedure Tail, " &
500 "justify = center, pad = a");
503 Tail
(Tail_String
, 1, Ada
.Strings
.Right
);
505 if Tail_String
/= " a" then
506 Report
.Failed
("Incorrect result from Procedure Tail, " &
507 "justify = right, default pad");
510 Tail
(Tail_String
, 19, Ada
.Strings
.Right
, 'A');
512 if Tail_String
/= "A a" then
513 Report
.Failed
("Incorrect result from Procedure Tail, " &
514 "justify = right, pad = A");
520 when others => Report
.Failed
("Exception raised in Test_Block");