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

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 -- CXA4015.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 the subprograms defined in package Ada.Strings.Wide_Fixed
28 -- are available, and that they produce correct results. Specifically,
29 -- check the subprograms Count, Find_Token, Index, Index_Non_Blank, and
30 -- Move.
31 --
32 -- TEST DESCRIPTION:
33 -- This test, when combined with tests CXA4013,14,16 will provide
34 -- coverage of the functionality found in Ada.Strings.Wide_Fixed.
35 -- This test contains many small, specific test cases, situations that
36 -- although common in user environments, are often difficult to generate
37 -- in large numbers in a application-based test.
38 --
39 --
40 -- CHANGE HISTORY:
41 -- 06 Dec 94 SAIC ACVC 2.0
42 -- 02 Nov 95 SAIC Corrected various accesssibility problems and
43 -- expected result strings for ACVC 2.0.1.
44 --
45 --!
46
47 package CXA40150 is
48
49 -- Wide Character mapping function defined for use with specific
50 -- versions of functions Index and Count.
51
52 function AK_to_ZQ_Mapping (From : Wide_Character) return Wide_Character;
53
54 end CXA40150;
55
56 package body CXA40150 is
57
58 function AK_to_ZQ_Mapping (From : Wide_Character)
59 return Wide_Character is
60 begin
61 if From = 'a' then
62 return 'z';
63 elsif From = 'k' then
64 return 'q';
65 else
66 return From;
67 end if;
68 end AK_to_ZQ_Mapping;
69
70 end CXA40150;
71
72
73 with CXA40150;
74 with Report;
75 with Ada.Strings;
76 with Ada.Strings.Wide_Fixed;
77 with Ada.Strings.Wide_Maps;
78
79 procedure CXA4015 is
80 begin
81
82 Report.Test("CXA4015", "Check that the subprograms defined in " &
83 "package Ada.Strings.Wide_Fixed are available, " &
84 "and that they produce correct results");
85
86
87 Test_Block:
88 declare
89
90 use CXA40150;
91
92 package ASF renames Ada.Strings.Wide_Fixed;
93 package Maps renames Ada.Strings.Wide_Maps;
94
95 Result_String : Wide_String(1..10) :=
96 (others => Ada.Strings.Wide_Space);
97
98 Source_String1 : Wide_String(1..5) := "abcde"; -- odd len Wide_String
99 Source_String2 : Wide_String(1..6) := "abcdef"; -- even len Wide_String
100 Source_String3 : Wide_String(1..12) := "abcdefghijkl";
101 Source_String4 : Wide_String(1..12) := "abcdefghij "; -- last 2 ch pad
102 Source_String5 : Wide_String(1..12) := " cdefghijkl"; -- first 2 ch pad
103 Source_String6 : Wide_String(1..12) := "abcdefabcdef";
104
105 Location : Natural := 0;
106 Slice_Start : Positive;
107 Slice_End,
108 Slice_Count : Natural := 0;
109
110 CD_Set : Maps.Wide_Character_Set := Maps.To_Set("cd");
111 ABCD_Set : Maps.Wide_Character_Set := Maps.To_Set("abcd");
112 A_to_F_Set : Maps.Wide_Character_Set := Maps.To_Set("abcdef");
113
114 CD_to_XY_Map : Maps.Wide_Character_Mapping :=
115 Maps.To_Mapping(From => "cd", To => "xy");
116
117
118 -- Access-to-Subprogram object defined for use with specific versions of
119 -- functions Index and Count.
120
121 Map_Ptr : Maps.Wide_Character_Mapping_Function :=
122 AK_to_ZQ_Mapping'Access;
123
124
125 begin
126
127
128 -- Procedure Move
129 -- Evaluate the Procedure Move with various combinations of
130 -- parameters.
131
132 -- Justify = Left (default case)
133
134 ASF.Move(Source => Source_String1, -- "abcde"
135 Target => Result_String);
136
137 if Result_String /= "abcde " then
138 Report.Failed("Incorrect result from Move with Justify = Left");
139 end if;
140
141 -- Justify = Right
142
143 ASF.Move(Source => Source_String2, -- "abcdef"
144 Target => Result_String,
145 Drop => Ada.Strings.Error,
146 Justify => Ada.Strings.Right);
147
148 if Result_String /= " abcdef" then
149 Report.Failed("Incorrect result from Move with Justify = Right");
150 end if;
151
152 -- Justify = Center (two cases, odd and even pad lengths)
153
154 ASF.Move(Source_String1, -- "abcde"
155 Result_String,
156 Ada.Strings.Error,
157 Ada.Strings.Center,
158 'x'); -- non-default padding.
159
160 if Result_String /= "xxabcdexxx" then -- Unequal padding added right
161 Report.Failed("Incorrect result from Move with Justify = Center-1");
162 end if;
163
164 ASF.Move(Source_String2, -- "abcdef"
165 Result_String,
166 Ada.Strings.Error,
167 Ada.Strings.Center);
168
169 if Result_String /= " abcdef " then -- Equal padding added on L/R.
170 Report.Failed("Incorrect result from Move with Justify = Center-2");
171 end if;
172
173 -- When the source Wide_String is longer than the target Wide_String,
174 -- several cases can be examined, with the results depending on the
175 -- value of the Drop parameter.
176
177 -- Drop = Left
178
179 ASF.Move(Source => Source_String3, -- "abcdefghijkl"
180 Target => Result_String,
181 Drop => Ada.Strings.Left);
182
183 if Result_String /= "cdefghijkl" then
184 Report.Failed("Incorrect result from Move with Drop = Left");
185 end if;
186
187 -- Drop = Right
188
189 ASF.Move(Source_String3, Result_String, Ada.Strings.Right);
190
191 if Result_String /= "abcdefghij" then
192 Report.Failed("Incorrect result from Move with Drop = Right");
193 end if;
194
195 -- Drop = Error
196 -- The effect in this case depends on the value of the justify
197 -- parameter, and on whether any characters in Source other than
198 -- Pad would fail to be copied.
199
200 -- Drop = Error, Justify = Left, right overflow characters are pad.
201
202 ASF.Move(Source => Source_String4, -- "abcdefghij "
203 Target => Result_String,
204 Drop => Ada.Strings.Error,
205 Justify => Ada.Strings.Left);
206
207 if not(Result_String = "abcdefghij") then -- leftmost 10 characters
208 Report.Failed("Incorrect result from Move with Drop = Error - 1");
209 end if;
210
211 -- Drop = Error, Justify = Right, left overflow characters are pad.
212
213 ASF.Move(Source_String5, -- " cdefghijkl"
214 Result_String,
215 Ada.Strings.Error,
216 Ada.Strings.Right);
217
218 if Result_String /= "cdefghijkl" then -- rightmost 10 characters
219 Report.Failed("Incorrect result from Move with Drop = Error - 2");
220 end if;
221
222 -- In other cases of Drop=Error, Length_Error is propagated, such as:
223
224 begin
225
226 ASF.Move(Source_String3, -- 12 characters, no Pad.
227 Result_String, -- 10 characters
228 Ada.Strings.Error,
229 Ada.Strings.Left);
230
231 Report.Failed("Length_Error not raised by Move - 1");
232
233 exception
234 when Ada.Strings.Length_Error => null; -- OK
235 when others =>
236 Report.Failed("Incorrect exception raised by Move - 1");
237 end;
238
239
240
241 -- Function Index
242 -- (Other usage examples of this function found in CXA4013-14.)
243 -- Check when the pattern is not found in the source.
244
245 if ASF.Index("abcdef", "gh") /= 0 or
246 ASF.Index("abcde", "abcdef") /= 0 or -- pattern > source
247 ASF.Index("xyz",
248 "abcde",
249 Ada.Strings.Backward) /= 0 or
250 ASF.Index("", "ab") /= 0 or -- null source Wide_String.
251 ASF.Index("abcde", " ") /= 0 -- blank pattern.
252 then
253 Report.Failed("Incorrect result from Index, no pattern match");
254 end if;
255
256 -- Check that Pattern_Error is raised when the pattern is the
257 -- null Wide_String.
258 begin
259 Location := ASF.Index(Source_String6, -- "abcdefabcdef"
260 "", -- null pattern Wide_String.
261 Ada.Strings.Forward);
262 Report.Failed("Pattern_Error not raised by Index");
263 exception
264 when Ada.Strings.Pattern_Error => null; -- OK, expected exception.
265 when others =>
266 Report.Failed("Incorrect exception raised by Index, null pattern");
267 end;
268
269 -- Use the search direction "backward" to locate the particular
270 -- pattern within the source Wide_String.
271
272 Location := ASF.Index(Source_String6, -- "abcdefabcdef"
273 "de", -- slice 4..5, 10..11
274 Ada.Strings.Backward); -- search from right end.
275
276 if Location /= 10 then
277 Report.Failed("Incorrect result from Index going Backward");
278 end if;
279
280
281
282 -- Function Index
283 -- Use the version of Index that takes a Wide_Character_Mapping_Function
284 -- parameter.
285 -- Use the search directions Forward and Backward to locate the
286 -- particular pattern wide string within the source wide string.
287
288 Location := ASF.Index("akzqefakzqef",
289 "qzq", -- slice 8..10
290 Ada.Strings.Backward,
291 Map_Ptr); -- perform 'a' to 'z', 'k' to 'q'
292 -- translation.
293 if Location /= 8 then
294 Report.Failed
295 ("Incorrect result from Index w/map ptr going Backward");
296 end if;
297
298 Location := ASF.Index("ddkkddakcdakdefcadckdfzaaqd",
299 "zq", -- slice 7..8
300 Ada.Strings.Forward,
301 Map_Ptr); -- perform 'a' to 'z', 'k' to 'q'
302 -- translation.
303 if Location /= 7 then
304 Report.Failed
305 ("Incorrect result from Index w/map ptr going Forward");
306 end if;
307
308
309 if ASF.Index("aakkzq", "zq", Ada.Strings.Forward, Map_Ptr) /= 2 or
310 ASF.Index("qzedka", "qz", Ada.Strings.Backward, Map_Ptr) /= 5 or
311 ASF.Index("zazaza", "zzzz", Ada.Strings.Backward, Map_Ptr) /= 3 or
312 ASF.Index("kka", "qqz", Ada.Strings.Forward, Map_Ptr) /= 1
313 then
314 Report.Failed("Incorrect result from Index w/map ptr");
315 end if;
316
317
318 -- Check when the pattern wide string is not found in the source.
319
320 if ASF.Index("akzqef", "kzq", Ada.Strings.Forward, Map_Ptr) /= 0 or
321 ASF.Index("abcde", "abcdef", Ada.Strings.Backward, Map_Ptr) /= 0 or
322 ASF.Index("xyz", "akzde", Ada.Strings.Backward, Map_Ptr) /= 0 or
323 ASF.Index("", "zq", Ada.Strings.Forward, Map_Ptr) /= 0 or
324 ASF.Index("akcde", " ", Ada.Strings.Backward, Map_Ptr) /= 0
325 then
326 Report.Failed
327 ("Incorrect result from Index w/map ptr, no pattern match");
328 end if;
329
330 -- Check that Pattern_Error is raised when the pattern is a
331 -- null Wide_String.
332 begin
333 Location := ASF.Index("akzqefakqzef",
334 "", -- null pattern Wide_String.
335 Ada.Strings.Forward,
336 Map_Ptr);
337 Report.Failed("Pattern_Error not raised by Index w/map ptr");
338 exception
339 when Ada.Strings.Pattern_Error => null; -- OK, expected exception.
340 when others =>
341 Report.Failed
342 ("Incorrect exception raised by Index w/map ptr, null pattern");
343 end;
344
345
346
347 -- Function Index
348 -- Using the version of Index testing wide character set membership,
349 -- check combinations of forward/backward, inside/outside parameter
350 -- configurations.
351
352 if ASF.Index(Source => Source_String1, -- "abcde"
353 Set => CD_Set,
354 Test => Ada.Strings.Inside,
355 Going => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3.
356 ASF.Index(Source_String6, -- "abcdefabcdef"
357 CD_Set,
358 Ada.Strings.Outside,
359 Ada.Strings.Backward) /= 12 or -- 'f' at position 12
360 ASF.Index(Source_String6, -- "abcdefabcdef"
361 CD_Set,
362 Ada.Strings.Inside,
363 Ada.Strings.Backward) /= 10 or -- 'd' at position 10
364 ASF.Index("cdcdcdcdacdcdcdcd",
365 CD_Set,
366 Ada.Strings.Outside,
367 Ada.Strings.Forward) /= 9 -- 'a' at position 9
368 then
369 Report.Failed("Incorrect result from function Index for sets - 1");
370 end if;
371
372 -- Additional interesting uses/combinations using Index for sets.
373
374 if ASF.Index("cd", -- same size, str-set
375 CD_Set,
376 Ada.Strings.Inside,
377 Ada.Strings.Forward) /= 1 or -- 'c' at position 1
378 ASF.Index("abcd", -- same size, str-set,
379 Maps.To_Set("efgh"), -- different contents.
380 Ada.Strings.Outside,
381 Ada.Strings.Forward) /= 1 or
382 ASF.Index("abccd", -- set > Wide_String
383 Maps.To_Set("acegik"),
384 Ada.Strings.Inside,
385 Ada.Strings.Backward) /= 4 or -- 'c' at position 4
386 ASF.Index("abcde",
387 Maps.Null_Set) /= 0 or
388 ASF.Index("", -- Null string.
389 CD_Set) /= 0 or
390 ASF.Index("abc ab", -- blank included
391 Maps.To_Set("e "), -- in Wide_String and
392 Ada.Strings.Inside, -- set.
393 Ada.Strings.Backward) /= 4 -- blank in Wide_Str.
394 then
395 Report.Failed("Incorrect result from function Index for sets - 2");
396 end if;
397
398
399
400 -- Function Index_Non_Blank.
401 -- (Other usage examples of this function found in CXA4013-14.)
402
403
404 if ASF.Index_Non_Blank(Source => Source_String4, -- "abcdefghij "
405 Going => Ada.Strings.Backward) /= 10 or
406 ASF.Index_Non_Blank("abc def ghi jkl ",
407 Ada.Strings.Backward) /= 15 or
408 ASF.Index_Non_Blank(" abcdef") /= 3 or
409 ASF.Index_Non_Blank(" ") /= 0
410 then
411 Report.Failed("Incorrect result from Index_Non_Blank");
412 end if;
413
414
415
416 -- Function Count
417 -- (Other usage examples of this function found in CXA4013-14.)
418
419 if ASF.Count("abababa", "aba") /= 2 or
420 ASF.Count("abababa", "ab" ) /= 3 or
421 ASF.Count("babababa", "ab") /= 3 or
422 ASF.Count("abaabaaba", "aba") /= 3 or
423 ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy") /= 1 or
424 ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x") /= 20
425 then
426 Report.Failed("Incorrect result from Function Count");
427 end if;
428
429 -- Determine the number of slices of Source that when mapped to a
430 -- non-identity map, match the pattern Wide_String.
431
432 Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef"
433 "xy",
434 CD_to_XY_Map); -- maps 'c' to 'x', 'd' to 'y'
435
436 if Slice_Count /= 2 then -- two slices "xy" in "mapped" Source_String6
437 Report.Failed("Incorrect result from Count with non-identity map");
438 end if;
439
440 -- If the pattern supplied to Function Count is the null Wide_String,
441 -- then Pattern_Error is propagated.
442 declare
443 The_Null_Wide_String : constant Wide_String := "";
444 begin
445 Slice_Count := ASF.Count(Source_String6, The_Null_Wide_String);
446 Report.Failed("Pattern_Error not raised by Function Count");
447 exception
448 when Ada.Strings.Pattern_Error => null; -- OK
449 when others =>
450 Report.Failed("Incorrect exception from Count with null pattern");
451 end;
452
453
454
455
456 -- Function Count
457 -- Use the version of Count that takes a Wide_Character_Mapping_Function
458 -- value as the basis of its source mapping.
459
460 if ASF.Count("akakaka", "zqz", Map_Ptr) /= 2 or
461 ASF.Count("akakaka", "qz", Map_Ptr) /= 3 or
462 ASF.Count("kakakaka", "q", Map_Ptr) /= 4 or
463 ASF.Count("zzqaakzaqzzk", "zzq", Map_Ptr) /= 4 or
464 ASF.Count(" ", "z", Map_Ptr) /= 0 or
465 ASF.Count("", "qz", Map_Ptr) /= 0 or
466 ASF.Count("abbababab", "zq", Map_Ptr) /= 0 or
467 ASF.Count("aaaaaaaaaaaaaaaaaakk", "zqq", Map_Ptr) /= 1 or
468 ASF.Count("azaazaazzzaaaaazzzza", "z", Map_Ptr) /= 20
469 then
470 Report.Failed("Incorrect result from Function Count w/map ptr");
471 end if;
472
473 -- If the pattern supplied to Function Count is a null Wide_String,
474 -- then Pattern_Error is propagated.
475 declare
476 The_Null_Wide_String : constant Wide_String := "";
477 begin
478 Slice_Count := ASF.Count(Source_String6,
479 The_Null_Wide_String,
480 Map_Ptr);
481 Report.Failed
482 ("Pattern_Error not raised by Function Count w/map ptr");
483 exception
484 when Ada.Strings.Pattern_Error => null; -- OK
485 when others =>
486 Report.Failed
487 ("Incorrect exception from Count w/map ptr, null pattern");
488 end;
489
490
491
492
493 -- Function Count returning the number of characters in a particular
494 -- set that are found in source Wide_String.
495
496 if ASF.Count(Source_String6, CD_Set) /= 4 or -- 2 'c' and 'd' chars.
497 ASF.Count("cddaccdaccdd", CD_Set) /= 10
498 then
499 Report.Failed("Incorrect result from Count with set");
500 end if;
501
502
503
504 -- Function Find_Token.
505 -- (Other usage examples of this function found in CXA4013-14.)
506
507 ASF.Find_Token(Source => Source_String6, -- First slice with no
508 Set => ABCD_Set, -- 'a', 'b', 'c', or 'd'
509 Test => Ada.Strings.Outside, -- is "ef" at 5..6.
510 First => Slice_Start,
511 Last => Slice_End);
512
513 if Slice_Start /= 5 or Slice_End /= 6 then
514 Report.Failed("Incorrect result from Find_Token - 1");
515 end if;
516
517 -- If no appropriate slice is contained by the source Wide_String,
518 -- then the value returned in Last is zero, and the value in First is
519 -- Source'First.
520
521 ASF.Find_Token(Source_String6, -- "abcdefabcdef"
522 A_to_F_Set, -- Set of characters 'a' thru 'f'.
523 Ada.Strings.Outside, -- No characters outside this set.
524 Slice_Start,
525 Slice_End);
526
527 if Slice_Start /= Source_String6'First or Slice_End /= 0 then
528 Report.Failed("Incorrect result from Find_Token - 2");
529 end if;
530
531 -- Additional testing of Find_Token.
532
533 ASF.Find_Token("eabcdabcddcab",
534 ABCD_Set,
535 Ada.Strings.Inside,
536 Slice_Start,
537 Slice_End);
538
539 if Slice_Start /= 2 or Slice_End /= 13 then
540 Report.Failed("Incorrect result from Find_Token - 3");
541 end if;
542
543 ASF.Find_Token("efghijklabcdabcd",
544 ABCD_Set,
545 Ada.Strings.Outside,
546 Slice_Start,
547 Slice_End);
548
549 if Slice_Start /= 1 or Slice_End /= 8 then
550 Report.Failed("Incorrect result from Find_Token - 4");
551 end if;
552
553 ASF.Find_Token("abcdefgabcdabcd",
554 ABCD_Set,
555 Ada.Strings.Outside,
556 Slice_Start,
557 Slice_End);
558
559 if Slice_Start /= 5 or Slice_End /= 7 then
560 Report.Failed("Incorrect result from Find_Token - 5");
561 end if;
562
563 ASF.Find_Token("abcdcbabcdcba",
564 ABCD_Set,
565 Ada.Strings.Inside,
566 Slice_Start,
567 Slice_End);
568
569 if Slice_Start /= 1 or Slice_End /= 13 then
570 Report.Failed("Incorrect result from Find_Token - 6");
571 end if;
572
573
574 exception
575 when others => Report.Failed("Exception raised in Test_Block");
576 end Test_Block;
577
578 Report.Result;
579
580 end CXA4015;