|
111
|
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;
|
