Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/cxa/cxa4005.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 -- CXA4005.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.Fixed are | |
28 -- available, and that they produce correct results. Specifically, | |
29 -- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice, | |
30 -- Tail, Trim, and "*". | |
31 -- | |
32 -- TEST DESCRIPTION: | |
33 -- This test, when combined with tests CXA4002-4 will provide coverage | |
34 -- of the functionality found in Ada.Strings.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. They represent | |
38 -- individual usage paradigms in-the-small. | |
39 -- | |
40 -- | |
41 -- CHANGE HISTORY: | |
42 -- 06 Dec 94 SAIC ACVC 2.0 | |
43 -- 11 Apr 95 SAIC Corrected acceptance conditions of certain | |
44 -- subtests. | |
45 -- 06 Nov 95 SAIC Fixed bugs for ACVC 2.0.1. | |
46 -- 22 Feb 01 PHL Check that the lower bound of the result is 1. | |
47 -- 13 Mar 01 RLB Fixed a couple of ACATS style violations; | |
48 -- removed pointless checks of procedures. | |
49 -- Added checks of other functions. These changes | |
50 -- were made to test Defect Report 8652/0049, as | |
51 -- reflected in Technical Corrigendum 1. | |
52 -- | |
53 --! | |
54 | |
55 with Report; | |
56 with Ada.Strings; | |
57 with Ada.Strings.Fixed; | |
58 with Ada.Strings.Maps; | |
59 | |
60 procedure CXA4005 is | |
61 | |
62 type TC_Name_Holder is access String; | |
63 Name : TC_Name_Holder; | |
64 | |
65 function TC_Check (S : String) return String is | |
66 begin | |
67 if S'First /= 1 then | |
68 Report.Failed ("Lower bound of result of function " & Name.all & | |
69 " is" & Integer'Image (S'First)); | |
70 end if; | |
71 return S; | |
72 end TC_Check; | |
73 | |
74 procedure TC_Set_Name (N : String) is | |
75 begin | |
76 Name := new String'(N); | |
77 end TC_Set_Name; | |
78 | |
79 begin | |
80 | |
81 Report.Test("CXA4005", "Check that the subprograms defined in " & | |
82 "package Ada.Strings.Fixed are available, " & | |
83 "and that they produce correct results"); | |
84 | |
85 Test_Block: | |
86 declare | |
87 | |
88 package ASF renames Ada.Strings.Fixed; | |
89 package Maps renames Ada.Strings.Maps; | |
90 | |
91 Result_String, | |
92 Delete_String, | |
93 Insert_String, | |
94 Trim_String, | |
95 Overwrite_String : String(1..10) := (others => Ada.Strings.Space); | |
96 | |
97 Source_String1 : String(1..5) := "abcde"; -- odd length string | |
98 Source_String2 : String(1..6) := "abcdef"; -- even length string | |
99 Source_String3 : String(1..12) := "abcdefghijkl"; | |
100 Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad | |
101 Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad | |
102 Source_String6 : String(1..12) := "abcdefabcdef"; | |
103 | |
104 Location : Natural := 0; | |
105 Slice_Start : Positive; | |
106 Slice_End, | |
107 Slice_Count : Natural := 0; | |
108 | |
109 CD_Set : Maps.Character_Set := Maps.To_Set("cd"); | |
110 X_Set : Maps.Character_Set := Maps.To_Set('x'); | |
111 ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd"); | |
112 A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef"); | |
113 | |
114 CD_to_XY_Map : Maps.Character_Mapping := | |
115 Maps.To_Mapping(From => "cd", To => "xy"); | |
116 | |
117 begin | |
118 | |
119 -- Procedure Replace_Slice | |
120 -- The functionality of this procedure | |
121 -- is similar to procedure Move, and | |
122 -- is tested here in the same manner, evaluated | |
123 -- with various combinations of parameters. | |
124 | |
125 -- Index_Error propagation when Low > Source'Last + 1 | |
126 | |
127 begin | |
128 ASF.Replace_Slice(Result_String, | |
129 Result_String'Last + 2, -- should raise exception | |
130 Result_String'Last, | |
131 "xxxxxxx"); | |
132 Report.Failed("Index_Error not raised by Replace_Slice - 1"); | |
133 exception | |
134 when Ada.Strings.Index_Error => null; -- OK, expected exception. | |
135 when others => | |
136 Report.Failed("Incorrect exception from Replace_Slice - 1"); | |
137 end; | |
138 | |
139 -- Index_Error propagation when High < Source'First - 1 | |
140 | |
141 begin | |
142 ASF.Replace_Slice(Result_String(5..10), | |
143 5, | |
144 3, -- should raise exception since < 'First - 1. | |
145 "xxxxxxx"); | |
146 Report.Failed("Index_Error not raised by Replace_Slice - 2"); | |
147 exception | |
148 when Ada.Strings.Index_Error => null; -- OK, expected exception. | |
149 when others => | |
150 Report.Failed("Incorrect exception from Replace_Slice - 2"); | |
151 end; | |
152 | |
153 -- Justify = Left (default case) | |
154 | |
155 Result_String := "XXXXXXXXXX"; | |
156 | |
157 ASF.Replace_Slice(Source => Result_String, | |
158 Low => 1, | |
159 High => 10, | |
160 By => Source_String1); -- "abcde" | |
161 | |
162 if Result_String /= "abcde " then | |
163 Report.Failed("Incorrect result from Replace_Slice - Justify = Left"); | |
164 end if; | |
165 | |
166 -- Justify = Right | |
167 | |
168 ASF.Replace_Slice(Source => Result_String, | |
169 Low => 1, | |
170 High => Result_String'Last, | |
171 By => Source_String2, -- "abcdef" | |
172 Drop => Ada.Strings.Error, | |
173 Justify => Ada.Strings.Right); | |
174 | |
175 if Result_String /= " abcdef" then | |
176 Report.Failed("Incorrect result from Replace_Slice - Justify=Right"); | |
177 end if; | |
178 | |
179 -- Justify = Center (two cases, odd and even pad lengths) | |
180 | |
181 ASF.Replace_Slice(Result_String, | |
182 1, | |
183 Result_String'Last, | |
184 Source_String1, -- "abcde" | |
185 Ada.Strings.Error, | |
186 Ada.Strings.Center, | |
187 'x'); -- non-default padding. | |
188 | |
189 if Result_String /= "xxabcdexxx" then -- Unequal padding added right | |
190 Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1"); | |
191 end if; | |
192 | |
193 ASF.Replace_Slice(Result_String, | |
194 1, | |
195 Result_String'Last, | |
196 Source_String2, -- "abcdef" | |
197 Ada.Strings.Error, | |
198 Ada.Strings.Center); | |
199 | |
200 if Result_String /= " abcdef " then -- Equal padding added on L/R. | |
201 Report.Failed("Incorrect result from Replace_Slice with " & | |
202 "Justify = Center - 2"); | |
203 end if; | |
204 | |
205 -- When the source string is longer than the target string, several | |
206 -- cases can be examined, with the results depending on the value of | |
207 -- the Drop parameter. | |
208 | |
209 -- Drop = Left | |
210 | |
211 ASF.Replace_Slice(Result_String, | |
212 1, | |
213 Result_String'Last, | |
214 Source_String3, -- "abcdefghijkl" | |
215 Drop => Ada.Strings.Left); | |
216 | |
217 if Result_String /= "cdefghijkl" then | |
218 Report.Failed("Incorrect result from Replace_Slice - Drop=Left"); | |
219 end if; | |
220 | |
221 -- Drop = Right | |
222 | |
223 ASF.Replace_Slice(Result_String, | |
224 1, | |
225 Result_String'Last, | |
226 Source_String3, -- "abcdefghijkl" | |
227 Ada.Strings.Right); | |
228 | |
229 if Result_String /= "abcdefghij" then | |
230 Report.Failed("Incorrect result, Replace_Slice with Drop=Right"); | |
231 end if; | |
232 | |
233 -- Drop = Error | |
234 | |
235 -- The effect in this case depends on the value of the justify | |
236 -- parameter, and on whether any characters in Source other than | |
237 -- Pad would fail to be copied. | |
238 | |
239 -- Drop = Error, Justify = Left, right overflow characters are pad. | |
240 | |
241 ASF.Replace_Slice(Result_String, | |
242 1, | |
243 Result_String'Last, | |
244 Source_String4, -- "abcdefghij " | |
245 Drop => Ada.Strings.Error, | |
246 Justify => Ada.Strings.Left); | |
247 | |
248 if not(Result_String = "abcdefghij") then -- leftmost 10 characters | |
249 Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1"); | |
250 end if; | |
251 | |
252 -- Drop = Error, Justify = Right, left overflow characters are pad. | |
253 | |
254 ASF.Replace_Slice(Source => Result_String, | |
255 Low => 1, | |
256 High => Result_String'Last, | |
257 By => Source_String5, -- " cdefghijkl" | |
258 Drop => Ada.Strings.Error, | |
259 Justify => Ada.Strings.Right); | |
260 | |
261 if Result_String /= "cdefghijkl" then -- rightmost 10 characters | |
262 Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2"); | |
263 end if; | |
264 | |
265 -- In other cases of Drop=Error, Length_Error is propagated, such as: | |
266 | |
267 begin | |
268 | |
269 ASF.Replace_Slice(Source => Result_String, | |
270 Low => 1, | |
271 High => Result_String'Last, | |
272 By => Source_String3, -- "abcdefghijkl" | |
273 Drop => Ada.Strings.Error); | |
274 | |
275 Report.Failed("Length_Error not raised by Replace_Slice - 1"); | |
276 | |
277 exception | |
278 when Ada.Strings.Length_Error => null; -- OK | |
279 when others => | |
280 Report.Failed("Incorrect exception from Replace_Slice - 3"); | |
281 end; | |
282 | |
283 | |
284 -- Function Replace_Slice | |
285 | |
286 TC_Set_Name ("Replace_Slice"); | |
287 | |
288 if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x")) | |
289 /= "abxde" or -- High = Low | |
290 TC_Check (ASF.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or | |
291 TC_Check (ASF.Replace_Slice("abcd", 4, 1, "xy")) | |
292 /= "abcxyd" or -- High < Low | |
293 TC_Check (ASF.Replace_Slice("abc", 2, 3, "x")) /= "ax" or | |
294 TC_Check (ASF.Replace_Slice("a", 1, 1, "z")) /= "z" | |
295 then | |
296 Report.Failed("Incorrect result from Function Replace_Slice - 1"); | |
297 end if; | |
298 | |
299 if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z")) | |
300 /= "abcdz" or -- By length 1 | |
301 TC_Check (ASF.Replace_Slice("abc", 1, 3, "xyz")) | |
302 /= "xyz" or -- High > Low | |
303 TC_Check (ASF.Replace_Slice("abc", 3, 2, "xy")) | |
304 /= "abxyc" or -- insert | |
305 TC_Check (ASF.Replace_Slice("a", 1, 1, "xyz")) /= "xyz" | |
306 then | |
307 Report.Failed("Incorrect result from Function Replace_Slice - 2"); | |
308 end if; | |
309 | |
310 | |
311 | |
312 -- Function Insert. | |
313 | |
314 TC_Set_Name ("Insert"); | |
315 | |
316 declare | |
317 New_String : constant String := | |
318 TC_Check ( | |
319 ASF.Insert(Source => Source_String1(2..5), -- "bcde" | |
320 Before => 3, | |
321 New_Item => Source_String2)); -- "abcdef" | |
322 begin | |
323 if New_String /= "babcdefcde" then | |
324 Report.Failed("Incorrect result from Function Insert - 1"); | |
325 end if; | |
326 end; | |
327 | |
328 if TC_Check (ASF.Insert("a", 1, "z")) /= "za" or | |
329 TC_Check (ASF.Insert("abc", 3, "")) /= "abc" or | |
330 TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc" | |
331 then | |
332 Report.Failed("Incorrect result from Function Insert - 2"); | |
333 end if; | |
334 | |
335 begin | |
336 if TC_Check (ASF.Insert(Source => Source_String1(2..5), -- "bcde" | |
337 Before => Report.Ident_Int(7), | |
338 New_Item => Source_String2)) -- "abcdef" | |
339 /= "babcdefcde" then | |
340 Report.Failed("Index_Error not raised by Insert - 3A"); | |
341 else | |
342 Report.Failed("Index_Error not raised by Insert - 3B"); | |
343 end if; | |
344 exception | |
345 when Ada.Strings.Index_Error => null; -- OK, expected exception. | |
346 when others => | |
347 Report.Failed("Incorrect exception from Insert - 3"); | |
348 end; | |
349 | |
350 | |
351 -- Procedure Insert | |
352 | |
353 -- Drop = Right | |
354 | |
355 ASF.Insert(Source => Insert_String, | |
356 Before => 6, | |
357 New_Item => Source_String2, -- "abcdef" | |
358 Drop => Ada.Strings.Right); | |
359 | |
360 if Insert_String /= " abcde" then -- last char of New_Item dropped. | |
361 Report.Failed("Incorrect result from Insert with Drop = Right"); | |
362 end if; | |
363 | |
364 -- Drop = Left | |
365 | |
366 ASF.Insert(Source => Insert_String, -- 10 char string | |
367 Before => 2, -- 9 chars, 2..10 available | |
368 New_Item => Source_String3, -- 12 characters long. | |
369 Drop => Ada.Strings.Left); -- truncate from Left. | |
370 | |
371 if Insert_String /= "l abcde" then -- 10 chars, leading blank. | |
372 Report.Failed("Incorrect result from Insert with Drop=Left"); | |
373 end if; | |
374 | |
375 -- Drop = Error | |
376 | |
377 begin | |
378 ASF.Insert(Source => Result_String, -- 10 chars | |
379 Before => Result_String'Last, | |
380 New_Item => "abcdefghijk", | |
381 Drop => Ada.Strings.Error); | |
382 Report.Failed("Exception not raised by Procedure Insert"); | |
383 exception | |
384 when Ada.Strings.Length_Error => null; -- OK, expected exception | |
385 when others => | |
386 Report.Failed("Incorrect exception raised by Procedure Insert"); | |
387 end; | |
388 | |
389 | |
390 | |
391 -- Function Overwrite | |
392 | |
393 TC_Set_Name ("Overwrite"); | |
394 | |
395 Overwrite_String := TC_Check ( | |
396 ASF.Overwrite(Result_String, -- 10 chars | |
397 1, -- starting at pos=1 | |
398 Source_String3(1..10))); | |
399 | |
400 if Overwrite_String /= Source_String3(1..10) then | |
401 Report.Failed("Incorrect result from Function Overwrite - 1"); | |
402 end if; | |
403 | |
404 | |
405 if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or | |
406 TC_Check (ASF.Overwrite("a", 1, "xyz")) | |
407 /= "xyz" or -- chars appended | |
408 TC_Check (ASF.Overwrite("abc", 3, " ")) | |
409 /= "ab " or -- blanks appended | |
410 TC_Check (ASF.Overwrite("abcde", 1, "z" )) /= "zbcde" | |
411 then | |
412 Report.Failed("Incorrect result from Function Overwrite - 2"); | |
413 end if; | |
414 | |
415 | |
416 | |
417 -- Procedure Overwrite, with truncation. | |
418 | |
419 ASF.Overwrite(Source => Overwrite_String, -- 10 characters. | |
420 Position => 1, | |
421 New_Item => Source_String3, -- 12 characters. | |
422 Drop => Ada.Strings.Left); | |
423 | |
424 if Overwrite_String /= "cdefghijkl" then | |
425 Report.Failed("Incorrect result from Overwrite with Drop=Left"); | |
426 end if; | |
427 | |
428 -- The default drop value is Right, used here. | |
429 | |
430 ASF.Overwrite(Source => Overwrite_String, -- 10 characters. | |
431 Position => 1, | |
432 New_Item => Source_String3); -- 12 characters. | |
433 | |
434 if Overwrite_String /= "abcdefghij" then | |
435 Report.Failed("Incorrect result from Overwrite with Drop=Right"); | |
436 end if; | |
437 | |
438 -- Drop = Error | |
439 | |
440 begin | |
441 ASF.Overwrite(Source => Overwrite_String, -- 10 characters. | |
442 Position => 1, | |
443 New_Item => Source_String3, -- 12 characters. | |
444 Drop => Ada.Strings.Error); | |
445 Report.Failed("Exception not raised by Procedure Overwrite"); | |
446 exception | |
447 when Ada.Strings.Length_Error => null; -- OK, expected exception. | |
448 when others => | |
449 Report.Failed | |
450 ("Incorrect exception raised by Procedure Overwrite"); | |
451 end; | |
452 | |
453 Overwrite_String := "ababababab"; | |
454 ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z"); | |
455 ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z"); | |
456 ASF.Overwrite(Overwrite_String, 5, "zz"); | |
457 | |
458 if Overwrite_String /= "zbabzzabaz" then | |
459 Report.Failed("Incorrect result from Procedure Overwrite"); | |
460 end if; | |
461 | |
462 | |
463 | |
464 -- Function Delete | |
465 | |
466 TC_Set_Name ("Delete"); | |
467 | |
468 declare | |
469 New_String1 : constant String := -- This returns a 4 char string. | |
470 TC_Check (ASF.Delete(Source => Source_String3, | |
471 From => 3, | |
472 Through => 10)); | |
473 New_String2 : constant String := -- This returns Source. | |
474 TC_Check (ASF.Delete(Source_String3, 10, 3)); | |
475 begin | |
476 if New_String1 /= "abkl" or | |
477 New_String2 /= Source_String3 | |
478 then | |
479 Report.Failed("Incorrect result from Function Delete - 1"); | |
480 end if; | |
481 end; | |
482 | |
483 if TC_Check (ASF.Delete("a", 1, 1)) | |
484 /= "" or -- Source length = 1 | |
485 TC_Check (ASF.Delete("abc", 1, 2)) | |
486 /= "c" or -- From = Source'First | |
487 TC_Check (ASF.Delete("abc", 3, 3)) | |
488 /= "ab" or -- From = Source'Last | |
489 TC_Check (ASF.Delete("abc", 3, 1)) | |
490 /= "abc" -- From > Through | |
491 then | |
492 Report.Failed("Incorrect result from Function Delete - 2"); | |
493 end if; | |
494 | |
495 | |
496 | |
497 -- Procedure Delete | |
498 | |
499 -- Justify = Left | |
500 | |
501 Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij" | |
502 | |
503 ASF.Delete(Source => Delete_String, | |
504 From => 6, | |
505 Through => Delete_String'Last, | |
506 Justify => Ada.Strings.Left, | |
507 Pad => 'x'); -- pad with char 'x' | |
508 | |
509 if Delete_String /= "abcdexxxxx" then | |
510 Report.Failed("Incorrect result from Delete - Justify = Left"); | |
511 end if; | |
512 | |
513 -- Justify = Right | |
514 | |
515 ASF.Delete(Source => Delete_String, -- Remove x"s from end and | |
516 From => 6, -- shift right. | |
517 Through => Delete_String'Last, | |
518 Justify => Ada.Strings.Right, | |
519 Pad => 'x'); -- pad with char 'x' on left. | |
520 | |
521 if Delete_String /= "xxxxxabcde" then | |
522 Report.Failed("Incorrect result from Delete - Justify = Right"); | |
523 end if; | |
524 | |
525 -- Justify = Center | |
526 | |
527 ASF.Delete(Source => Delete_String, | |
528 From => 1, | |
529 Through => 5, | |
530 Justify => Ada.Strings.Center, | |
531 Pad => 'z'); | |
532 | |
533 if Delete_String /= "zzabcdezzz" then -- extra pad char on right side. | |
534 Report.Failed("Incorrect result from Delete - Justify = Center"); | |
535 end if; | |
536 | |
537 | |
538 | |
539 -- Function Trim | |
540 -- Use non-identity character sets to perform the trim operation. | |
541 | |
542 TC_Set_Name ("Trim"); | |
543 | |
544 Trim_String := "cdabcdefcd"; | |
545 | |
546 -- Remove the "cd" from each end of the string. This will not effect | |
547 -- the "cd" slice at 5..6. | |
548 | |
549 declare | |
550 New_String : constant String := | |
551 TC_Check (ASF.Trim(Source => Trim_String, | |
552 Left => CD_Set, Right => CD_Set)); | |
553 begin | |
554 if New_String /= Source_String2 then -- string "abcdef" | |
555 Report.Failed("Incorrect result from Trim with character sets"); | |
556 end if; | |
557 end; | |
558 | |
559 if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set)) | |
560 /= "abcdef" then | |
561 Report.Failed("Incorrect result from Trim with Null sets"); | |
562 end if; | |
563 | |
564 if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then | |
565 Report.Failed("Incorrect result from Trim, string removal"); | |
566 end if; | |
567 | |
568 | |
569 -- Procedure Trim | |
570 | |
571 -- Justify = Right | |
572 | |
573 ASF.Trim(Source => Trim_String, | |
574 Left => CD_Set, | |
575 Right => CD_Set, | |
576 Justify => Ada.Strings.Right, | |
577 Pad => 'x'); | |
578 | |
579 if Trim_String /= "xxxxabcdef" then | |
580 Report.Failed("Incorrect result from Trim with Justify = Right"); | |
581 end if; | |
582 | |
583 -- Justify = Left | |
584 | |
585 ASF.Trim(Source => Trim_String, | |
586 Left => X_Set, | |
587 Right => Maps.Null_Set, | |
588 Justify => Ada.Strings.Left, | |
589 Pad => Ada.Strings.Space); | |
590 | |
591 if Trim_String /= "abcdef " then -- Padded with 4 blanks on right. | |
592 Report.Failed("Incorrect result from Trim with Justify = Left"); | |
593 end if; | |
594 | |
595 -- Justify = Center | |
596 | |
597 ASF.Trim(Source => Trim_String, | |
598 Left => ABCD_Set, | |
599 Right => CD_Set, | |
600 Justify => Ada.Strings.Center, | |
601 Pad => 'x'); | |
602 | |
603 if Trim_String /= "xxef xx" then -- Padded with 2 pad chars on L/R | |
604 Report.Failed("Incorrect result from Trim with Justify = Center"); | |
605 end if; | |
606 | |
607 | |
608 | |
609 -- Function Head, demonstrating use of padding. | |
610 | |
611 TC_Set_Name ("Head"); | |
612 | |
613 -- Use the characters of Source_String1 ("abcde") and pad the | |
614 -- last five characters of Result_String with 'x' characters. | |
615 | |
616 | |
617 Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x')); | |
618 | |
619 if Result_String /= "abcdexxxxx" then | |
620 Report.Failed("Incorrect result from Function Head with padding"); | |
621 end if; | |
622 | |
623 if TC_Check (ASF.Head(" ab ", 2)) /= " " or | |
624 TC_Check (ASF.Head("a", 6, 'A')) /= "aAAAAA" or | |
625 TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc" or | |
626 TC_Check (ASF.Head(ASF.Head("abc ", 7, 'x'), 10, 'X')) | |
627 /= "abc xxXXX" | |
628 then | |
629 Report.Failed("Incorrect result from Function Head"); | |
630 end if; | |
631 | |
632 | |
633 | |
634 -- Function Tail, demonstrating use of padding. | |
635 | |
636 TC_Set_Name ("Tail"); | |
637 | |
638 -- Use the characters of Source_String1 ("abcde") and pad the | |
639 -- first five characters of Result_String with 'x' characters. | |
640 | |
641 Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x')); | |
642 | |
643 if Result_String /= "xxxxxabcde" then | |
644 Report.Failed("Incorrect result from Function Tail with padding"); | |
645 end if; | |
646 | |
647 if TC_Check (ASF.Tail("abcde ", 5)) | |
648 /= "cde " or -- blanks, back | |
649 TC_Check (ASF.Tail(" abc ", 8, ' ')) | |
650 /= " abc " or -- blanks, front/back | |
651 TC_Check (ASF.Tail("", 5, 'Z')) | |
652 /= "ZZZZZ" or -- pad characters only | |
653 TC_Check (ASF.Tail("abc", 0)) | |
654 /= "" or -- null result | |
655 TC_Check (ASF.Tail("abcdefgh", 3)) | |
656 /= "fgh" or | |
657 TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'), | |
658 10, | |
659 'X')) /= "XXXXx abc " | |
660 then | |
661 Report.Failed("Incorrect result from Function Tail"); | |
662 end if; | |
663 | |
664 | |
665 -- Function "*" - with (Natural, String) parameters | |
666 | |
667 TC_Set_Name ("""*"""); | |
668 | |
669 if TC_Check (ASF."*"(3, Source_String1)) /= "abcdeabcdeabcde" or | |
670 TC_Check (ASF."*"(2, Source_String2)) /= Source_String6 or | |
671 TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab" or | |
672 TC_Check (ASF."*"(0, Source_String1)) /= "" | |
673 then | |
674 Report.Failed("Incorrect result from Function ""*"" with strings"); | |
675 end if; | |
676 | |
677 exception | |
678 when others => Report.Failed("Exception raised in Test_Block"); | |
679 end Test_Block; | |
680 | |
681 Report.Result; | |
682 | |
683 end CXA4005; |