Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxa4026.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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;