111
|
1 -- CXA4026.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 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
|
|
31 -- results.
|
|
32 --
|
|
33 -- TEST DESCRIPTION:
|
|
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.
|
|
39 --
|
|
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.
|
|
47 --
|
|
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.
|
|
54 --
|
|
55 -- Results of all subprograms are compared with expected results.
|
|
56 --
|
|
57 --
|
|
58 -- CHANGE HISTORY:
|
|
59 -- 10 Feb 95 SAIC Initial prerelease version
|
|
60 -- 21 Apr 95 SAIC Modified definition of string variable Str_2.
|
|
61 --
|
|
62 --!
|
|
63
|
|
64
|
|
65 package CXA4026_0 is
|
|
66
|
|
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.
|
|
70
|
|
71 function Map_To_Lower_Case (From : Character) return Character;
|
|
72
|
|
73
|
|
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.
|
|
78
|
|
79 function Map_To_Upper_Case (From : Character) return Character;
|
|
80
|
|
81 end CXA4026_0;
|
|
82
|
|
83
|
|
84 with Ada.Characters.Handling;
|
|
85 package body CXA4026_0 is
|
|
86
|
|
87 function Map_To_Lower_Case (From : Character) return Character is
|
|
88 begin
|
|
89 if From in 'A'..'Z' then
|
|
90 return Character'Val(Character'Pos(From) -
|
|
91 (Character'Pos('A') - Character'Pos('a')));
|
|
92 else
|
|
93 return From;
|
|
94 end if;
|
|
95 end Map_To_Lower_Case;
|
|
96
|
|
97 function Map_To_Upper_Case (From : Character) return Character is
|
|
98 begin
|
|
99 return Ada.Characters.Handling.To_Upper(From);
|
|
100 end Map_To_Upper_Case;
|
|
101
|
|
102 end CXA4026_0;
|
|
103
|
|
104
|
|
105 with CXA4026_0;
|
|
106 with Ada.Strings.Fixed;
|
|
107 with Ada.Strings.Maps;
|
|
108 with Ada.Characters.Handling;
|
|
109 with Ada.Characters.Latin_1;
|
|
110 with Report;
|
|
111
|
|
112 procedure CXA4026 is
|
|
113
|
|
114 begin
|
|
115
|
|
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");
|
|
121
|
|
122 Test_Block:
|
|
123 declare
|
|
124
|
|
125 use Ada.Strings, CXA4026_0;
|
|
126
|
|
127 -- The following strings are used in examination of the Translation
|
|
128 -- subprograms.
|
|
129
|
|
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;
|
|
141
|
|
142
|
|
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;
|
|
154
|
|
155
|
|
156 -- Functions used to supply mapping capability.
|
|
157
|
|
158
|
|
159 -- Access objects that will be provided as parameters to the
|
|
160 -- subprograms.
|
|
161
|
|
162 Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
|
|
163 Map_To_Lower_Case'Access;
|
|
164
|
|
165 Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
|
|
166 Map_To_Upper_Case'Access;
|
|
167
|
|
168
|
|
169 begin
|
|
170
|
|
171 -- Function Index, Forward direction search.
|
|
172 -- Note: Several of the following cases use the default value
|
|
173 -- Forward for the Going parameter.
|
|
174
|
|
175 if Fixed.Index(Source => "The library package Strings.Fixed",
|
|
176 Pattern => "fix",
|
|
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",
|
|
180 "ain",
|
|
181 Mapping => Map_To_Lower_Case_Ptr) /= 6 or
|
|
182 Fixed.Index("maximum number",
|
|
183 "um",
|
|
184 Ada.Strings.Forward,
|
|
185 Map_To_Lower_Case_Ptr) /= 6 or
|
|
186 Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
|
|
187 "MIXED CASE STRING",
|
|
188 Ada.Strings.Forward,
|
|
189 Map_To_Upper_Case_Ptr) /= 12 or
|
|
190 Fixed.Index("STRING WITH NO MATCHING PATTERNS",
|
|
191 "WITH",
|
|
192 Ada.Strings.Forward,
|
|
193 Map_To_Lower_Case_Ptr) /= 0 or
|
|
194 Fixed.Index("THIS STRING IS IN UPPER CASE",
|
|
195 "IS",
|
|
196 Ada.Strings.Forward,
|
|
197 Map_To_Upper_Case_Ptr) /= 3 or
|
|
198 Fixed.Index("", -- Null string.
|
|
199 "is",
|
|
200 Mapping => Map_To_Lower_Case_Ptr) /= 0 or
|
|
201 Fixed.Index("AAABBBaaabbb",
|
|
202 "aabb",
|
|
203 Mapping => Map_To_Lower_Case_Ptr) /= 2
|
|
204 then
|
|
205 Report.Failed("Incorrect results from Function Index, going " &
|
|
206 "in Forward direction, using a Character Mapping " &
|
|
207 "Function parameter");
|
|
208 end if;
|
|
209
|
|
210
|
|
211
|
|
212 -- Function Index, Backward direction search.
|
|
213
|
|
214 if Fixed.Index("Case of a Mixed Case String",
|
|
215 "case",
|
|
216 Ada.Strings.Backward,
|
|
217 Map_To_Lower_Case_Ptr) /= 17 or
|
|
218 Fixed.Index("Case of a Mixed Case String",
|
|
219 "CASE",
|
|
220 Ada.Strings.Backward,
|
|
221 Map_To_Upper_Case_Ptr) /= 17 or
|
|
222 Fixed.Index("rain, Rain, and more RAIN",
|
|
223 "rain",
|
|
224 Ada.Strings.Backward,
|
|
225 Map_To_Lower_Case_Ptr) /= 22 or
|
|
226 Fixed.Index("RIGHT place, right time",
|
|
227 "RIGHT",
|
|
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
|
|
234 then
|
|
235 Report.Failed("Incorrect results from Function Index, going " &
|
|
236 "in Backward direction, using a Character Mapping " &
|
|
237 "Function parameter");
|
|
238 end if;
|
|
239
|
|
240
|
|
241
|
|
242 -- Function Index, Pattern_Error if Pattern = Null_String
|
|
243
|
|
244 declare
|
|
245 use Ada.Strings.Fixed;
|
|
246 Null_Pattern_String : constant String := "";
|
|
247 TC_Natural : Natural := 1000;
|
|
248 begin
|
|
249 TC_Natural := Index("A Valid String",
|
|
250 Null_Pattern_String,
|
|
251 Ada.Strings.Forward,
|
|
252 Map_To_Lower_Case_Ptr);
|
|
253 Report.Failed("Pattern_Error not raised by Function Index when " &
|
|
254 "given a null pattern string");
|
|
255 exception
|
|
256 when Pattern_Error => null; -- OK, expected exception.
|
|
257 when others =>
|
|
258 Report.Failed("Incorrect exception raised by Function Index " &
|
|
259 "using a Character Mapping Function parameter " &
|
|
260 "when given a null pattern string");
|
|
261 end;
|
|
262
|
|
263
|
|
264
|
|
265 -- Function Count.
|
|
266
|
|
267 if Fixed.Count(Source => "ABABABA",
|
|
268 Pattern => "aba",
|
|
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",
|
|
272 "is",
|
|
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",
|
|
276 "is",
|
|
277 Map_To_Upper_Case_Ptr) /= 0 or
|
|
278 Fixed.Count("She sells sea shells by the sea shore",
|
|
279 "s",
|
|
280 Map_To_Lower_Case_Ptr) /= 8 or
|
|
281 Fixed.Count("", -- Null string.
|
|
282 "match",
|
|
283 Map_To_Upper_Case_Ptr) /= 0
|
|
284 then
|
|
285 Report.Failed("Incorrect results from Function Count, using " &
|
|
286 "a Character Mapping Function parameter");
|
|
287 end if;
|
|
288
|
|
289
|
|
290
|
|
291 -- Function Count, Pattern_Error if Pattern = Null_String
|
|
292
|
|
293 declare
|
|
294 use Ada.Strings.Fixed;
|
|
295 Null_Pattern_String : constant String := "";
|
|
296 TC_Natural : Natural := 1000;
|
|
297 begin
|
|
298 TC_Natural := Count("A Valid String",
|
|
299 Null_Pattern_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");
|
|
304 exception
|
|
305 when Pattern_Error => null; -- OK, expected exception.
|
|
306 when others =>
|
|
307 Report.Failed("Incorrect exception raised by Function Count " &
|
|
308 "using a Character Mapping Function parameter " &
|
|
309 "when given a null pattern string");
|
|
310 end;
|
|
311
|
|
312
|
|
313
|
|
314 -- Function Translate.
|
|
315
|
|
316 if Fixed.Translate(Source => "A Sample Mixed Case String",
|
|
317 Mapping => Map_To_Lower_Case_Ptr) /=
|
|
318 "a sample mixed case string" or
|
|
319
|
|
320 Fixed.Translate("ALL LOWER CASE",
|
|
321 Map_To_Lower_Case_Ptr) /=
|
|
322 "all lower case" or
|
|
323
|
|
324 Fixed.Translate("end with lower case",
|
|
325 Map_To_Lower_Case_Ptr) /=
|
|
326 "end with lower case" or
|
|
327
|
|
328 Fixed.Translate("", Map_To_Lower_Case_Ptr) /=
|
|
329 "" or
|
|
330
|
|
331 Fixed.Translate("start with lower case",
|
|
332 Map_To_Upper_Case_Ptr) /=
|
|
333 "START WITH LOWER CASE" or
|
|
334
|
|
335 Fixed.Translate("ALL UPPER CASE STRING",
|
|
336 Map_To_Upper_Case_Ptr) /=
|
|
337 "ALL UPPER CASE STRING" or
|
|
338
|
|
339 Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs",
|
|
340 Map_To_Upper_Case_Ptr) /=
|
|
341 "LOTS OF MIXED CASE CHARACTERS" or
|
|
342
|
|
343 Fixed.Translate("", Map_To_Upper_Case_Ptr) /=
|
|
344 "" or
|
|
345
|
|
346 Fixed.Translate(New_Character_String,
|
|
347 Map_To_Upper_Case_Ptr) /=
|
|
348 TC_New_Character_String
|
|
349 then
|
|
350 Report.Failed("Incorrect results from Function Translate, using " &
|
|
351 "a Character Mapping Function parameter");
|
|
352 end if;
|
|
353
|
|
354
|
|
355
|
|
356 -- Procedure Translate.
|
|
357
|
|
358 declare
|
|
359
|
|
360 use Ada.Strings.Fixed;
|
|
361
|
|
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;
|
|
367
|
|
368 begin
|
|
369
|
|
370 Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
|
|
371
|
|
372 if Str_1 /= "an all upper case string" then
|
|
373 Report.Failed("Incorrect result from Procedure Translate - 1");
|
|
374 end if;
|
|
375
|
|
376 Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
|
|
377
|
|
378 if Str_1 /= TC_Str_1 then
|
|
379 Report.Failed("Incorrect result from Procedure Translate - 2");
|
|
380 end if;
|
|
381
|
|
382 Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr);
|
|
383
|
|
384 if Str_2 /= "a mixed case string" then
|
|
385 Report.Failed("Incorrect result from Procedure Translate - 3");
|
|
386 end if;
|
|
387
|
|
388 Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr);
|
|
389
|
|
390 if Str_2 /= "A MIXED CASE STRING" then
|
|
391 Report.Failed("Incorrect result from Procedure Translate - 4");
|
|
392 end if;
|
|
393
|
|
394 Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr);
|
|
395
|
|
396 if Str_3 /= TC_Str_3 then
|
|
397 Report.Failed("Incorrect result from Procedure Translate - 5");
|
|
398 end if;
|
|
399
|
|
400 Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr);
|
|
401
|
|
402 if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then
|
|
403 Report.Failed("Incorrect result from Procedure Translate - 6");
|
|
404 end if;
|
|
405
|
|
406 Translate(New_Character_String, Map_To_Upper_Case_Ptr);
|
|
407
|
|
408 if New_Character_String /= TC_New_Character_String then
|
|
409 Report.Failed("Incorrect result from Procedure Translate - 6");
|
|
410 end if;
|
|
411
|
|
412 end;
|
|
413
|
|
414
|
|
415 -- Procedure Trim.
|
|
416
|
|
417 declare
|
|
418 Use Ada.Strings.Fixed;
|
|
419 Trim_String : String(1..30) := " A string of characters ";
|
|
420 begin
|
|
421
|
|
422 Trim(Source => Trim_String,
|
|
423 Side => Ada.Strings.Left,
|
|
424 Justify => Ada.Strings.Right,
|
|
425 Pad => 'x');
|
|
426
|
|
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");
|
|
430 end if;
|
|
431
|
|
432 Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
|
|
433
|
|
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");
|
|
437 end if;
|
|
438
|
|
439 Trim(Trim_String, Ada.Strings.Both, Pad => '*');
|
|
440
|
|
441 if Trim_String /= "xxxxA string of characters****" then
|
|
442 Report.Failed("Incorrect result from Procedure Trim, trim " &
|
|
443 "side = both, default justify, pad = *");
|
|
444 end if;
|
|
445
|
|
446 end;
|
|
447
|
|
448
|
|
449 -- Procedure Head.
|
|
450
|
|
451 declare
|
|
452 Fixed_String : String(1..20) := "A sample test string";
|
|
453 begin
|
|
454
|
|
455 Fixed.Head(Source => Fixed_String,
|
|
456 Count => 14,
|
|
457 Justify => Ada.Strings.Center,
|
|
458 Pad => '$');
|
|
459
|
|
460 if Fixed_String /= "$$$A sample test $$$" then
|
|
461 Report.Failed("Incorrect result from Procedure Head, " &
|
|
462 "justify = center, pad = $");
|
|
463 end if;
|
|
464
|
|
465 Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
|
|
466
|
|
467 if Fixed_String /= " $$$A sample" then
|
|
468 Report.Failed("Incorrect result from Procedure Head, " &
|
|
469 "justify = right, default pad");
|
|
470 end if;
|
|
471
|
|
472 Fixed.Head(Fixed_String, 9, Pad => '*');
|
|
473
|
|
474 if Fixed_String /= " ***********" then
|
|
475 Report.Failed("Incorrect result from Procedure Head, " &
|
|
476 "default justify, pad = *");
|
|
477 end if;
|
|
478
|
|
479 end;
|
|
480
|
|
481
|
|
482 -- Procedure Tail.
|
|
483
|
|
484 declare
|
|
485 Use Ada.Strings.Fixed;
|
|
486 Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
|
|
487 begin
|
|
488
|
|
489 Tail(Source => Tail_String, Count => 10, Pad => '-');
|
|
490
|
|
491 if Tail_String /= "KLMNOPQRST----------" then
|
|
492 Report.Failed("Incorrect result from Procedure Tail, " &
|
|
493 "default justify, pad = -");
|
|
494 end if;
|
|
495
|
|
496 Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a');
|
|
497
|
|
498 if Tail_String /= "aaaaaaa------aaaaaaa" then
|
|
499 Report.Failed("Incorrect result from Procedure Tail, " &
|
|
500 "justify = center, pad = a");
|
|
501 end if;
|
|
502
|
|
503 Tail(Tail_String, 1, Ada.Strings.Right);
|
|
504
|
|
505 if Tail_String /= " a" then
|
|
506 Report.Failed("Incorrect result from Procedure Tail, " &
|
|
507 "justify = right, default pad");
|
|
508 end if;
|
|
509
|
|
510 Tail(Tail_String, 19, Ada.Strings.Right, 'A');
|
|
511
|
|
512 if Tail_String /= "A a" then
|
|
513 Report.Failed("Incorrect result from Procedure Tail, " &
|
|
514 "justify = right, pad = A");
|
|
515 end if;
|
|
516
|
|
517 end;
|
|
518
|
|
519 exception
|
|
520 when others => Report.Failed ("Exception raised in Test_Block");
|
|
521 end Test_Block;
|
|
522
|
|
523
|
|
524 Report.Result;
|
|
525
|
|
526 end CXA4026;
|