Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb3016.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 -- CXB3016.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 function Virtual_Length returns the number of elements
28 -- in the array referenced by the Pointer parameter Ref, up to (but
29 -- not including) the (first) instance of the element specified in
30 -- the Terminator parameter.
31 --
32 -- Check that the procedure Copy_Terminated_Array copies the array of
33 -- elements referenced by Pointer parameter Source, into the array
34 -- pointed to by parameter Target, based on which of the following
35 -- two scenarios occurs first:
36 -- 1) copying the Terminator element, or
37 -- 2) copying the number of elements specified in parameter Limit.
38 --
39 -- Check that procedure Copy_Terminated_Array will propagate
40 -- Dereference_Error if either the Source or Target parameter is null.
41 --
42 -- Check that procedure Copy_Array will copy an array of elements
43 -- of length specified in parameter Length, referenced by the
44 -- Pointer parameter Source, into the array pointed to by parameter
45 -- Target.
46 --
47 -- Check that procedure Copy_Array will propagate Dereference_Error
48 -- if either the Source or Target parameter is null.
49 --
50 -- TEST DESCRIPTION:
51 -- This test checks that the function Virtual_Length and the procedures
52 -- Copy_Terminated_Array and Copy_Array in the generic package
53 -- Interfaces.C.Pointers will allow the user to manipulate arrays of
54 -- char and short values through the pointers that reference the
55 -- arrays.
56 --
57 -- Package Interfaces.C.Pointers is instantiated twice, once for
58 -- short values and once for chars. Pointers from each instantiated
59 -- package are then used to reference arrays of the appropriate
60 -- element type. The subprograms under test are used to determine the
61 -- length, and to copy, either portions or the entire content of the
62 -- arrays. The results of these operations are then compared against
63 -- expected results.
64 --
65 -- The propagation of Dereference_Error is checked for when either
66 -- of the two procedures is supplied with a null Pointer parameter.
67 --
68 -- This test assumes that the following characters are all included
69 -- in the implementation defined type Interfaces.C.char:
70 -- ' ', and 'a'..'z'.
71 --
72 -- APPLICABILITY CRITERIA:
73 -- This test is applicable to all implementations that provide
74 -- packages Interfaces.C, Interfaces.C.Strings, and
75 -- Interfaces.C.Pointers. If an implementation provides these packages,
76 -- this test must compile, execute, and report "PASSED".
77 --
78 --
79 -- CHANGE HISTORY:
80 -- 01 Feb 96 SAIC Initial release for 2.1
81 -- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
82 -- 26 Oct 96 SAIC Incorporated reviewer comments.
83 -- 26 Feb 97 PWB.CTA Moved code using null pointer to avoid errors
84 --!
85
86 with Report;
87 with Ada.Exceptions;
88 with Interfaces.C; -- N/A => ERROR
89 with Interfaces.C.Pointers; -- N/A => ERROR
90 with Interfaces.C.Strings; -- N/A => ERROR
91
92 procedure CXB3016 is
93 begin
94
95 Report.Test ("CXB3016", "Check that subprograms Virtual_Length, " &
96 "Copy_Terminated_Array, and Copy_Array " &
97 "produce correct results");
98
99 Test_Block:
100 declare
101
102 use Ada.Exceptions;
103 use Interfaces.C.Strings;
104
105 use type Interfaces.C.char,
106 Interfaces.C.char_array,
107 Interfaces.C.ptrdiff_t,
108 Interfaces.C.short,
109 Interfaces.C.size_t;
110
111 TC_char : Interfaces.C.char := 'a';
112 TC_ptrdiff_t : Interfaces.C.ptrdiff_t;
113 TC_Short : Interfaces.C.short := 0;
114 Min_Array_Size : Interfaces.C.size_t := 0;
115 Max_Array_Size : Interfaces.C.size_t := 20;
116 Short_Terminator : Interfaces.C.short := Interfaces.C.short'Last;
117 Alphabet : constant String := "abcdefghijklmnopqrstuvwxyz";
118 Blank_String : constant String := " ";
119
120 type Short_Array_Type is
121 array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short;
122
123 Ch_Array : Interfaces.C.char_array
124 (0..Interfaces.C.size_t(Alphabet'Length)) :=
125 Interfaces.C.To_C(Alphabet, True);
126
127 TC_Ch_Array : Interfaces.C.char_array
128 (0..Interfaces.C.size_t(Blank_String'Length)) :=
129 Interfaces.C.To_C(Blank_String, True);
130
131 Short_Array : Short_Array_Type(Min_Array_Size..Max_Array_Size);
132 TC_Short_Array : Short_Array_Type(Min_Array_Size..Max_Array_Size);
133
134
135 package Char_Pointers is new
136 Interfaces.C.Pointers (Index => Interfaces.C.size_t,
137 Element => Interfaces.C.char,
138 Element_Array => Interfaces.C.char_array,
139 Default_Terminator => Interfaces.C.nul);
140
141 package Short_Pointers is new
142 Interfaces.C.Pointers (Index => Interfaces.C.size_t,
143 Element => Interfaces.C.short,
144 Element_Array => Short_Array_Type,
145 Default_Terminator => Short_Terminator);
146
147 use Short_Pointers, Char_Pointers;
148
149 Short_Ptr : Short_Pointers.Pointer := Short_Array(0)'Access;
150 TC_Short_Ptr : Short_Pointers.Pointer := TC_Short_Array(0)'Access;
151 Char_Ptr : Char_Pointers.Pointer := Ch_Array(0)'Access;
152 TC_Char_Ptr : Char_Pointers.Pointer := TC_Ch_Array(0)'Access;
153
154 begin
155
156 -- Provide initial values for the array that holds short int values.
157
158 for i in Min_Array_Size..Max_Array_Size loop
159 Short_Array(i) := Interfaces.C.short(i);
160 TC_Short_Array(i) := 100;
161 end loop;
162
163 -- Set the final element of the short array object to be the "terminator"
164 -- element used in the instantiation above.
165
166 Short_Array(Max_Array_Size) := Short_Terminator;
167
168 -- Check starting pointer positions.
169
170 if Short_Ptr.all /= 0 or
171 Char_Ptr.all /= Ch_Array(0)
172 then
173 Report.Failed("Incorrect initial value for the first " &
174 "Char_Array or Short_Array values");
175 end if;
176
177
178
179 -- Check that function Virtual_Length returns the number of elements
180 -- in the array referenced by the Pointer parameter Ref, up to (but
181 -- not including) the (first) instance of the element specified in
182 -- the Terminator parameter.
183
184 TC_char := 'j';
185
186 TC_ptrdiff_t := Char_Pointers.Virtual_Length(Ref => Char_Ptr,
187 Terminator => TC_char);
188 if TC_ptrdiff_t /= 9 then
189 Report.Failed("Incorrect result from function Virtual_Length " &
190 "with Char_ptr parameter - 1");
191 end if;
192
193 TC_char := Interfaces.C.nul;
194
195 TC_ptrdiff_t := Char_Pointers.Virtual_Length(Char_Ptr,
196 Terminator => TC_char);
197 if TC_ptrdiff_t /= Interfaces.C.ptrdiff_t(Alphabet'Length) then
198 Report.Failed("Incorrect result from function Virtual_Length " &
199 "with Char_ptr parameter - 2");
200 end if;
201
202 TC_Short := 10;
203
204 TC_ptrdiff_t := Short_Pointers.Virtual_Length(Short_Ptr, TC_Short);
205
206 if TC_ptrdiff_t /= 10 then
207 Report.Failed("Incorrect result from function Virtual_Length " &
208 "with Short_ptr parameter - 1");
209 end if;
210
211 -- Replace an element of the Short_Array with the element used as the
212 -- terminator of the entire array; now there are two occurrences of the
213 -- terminator element in the array. The call to Virtual_Length should
214 -- return the number of array elements prior to the first terminator.
215
216 Short_Array(5) := Short_Terminator;
217
218 if Short_Pointers.Virtual_Length(Short_Ptr, Short_Terminator) /= 5
219 then
220 Report.Failed("Incorrect result from function Virtual_Length " &
221 "with Short_ptr parameter - 2");
222 end if;
223
224
225
226 -- Check that the procedure Copy_Terminated_Array copies the array of
227 -- elements referenced by Pointer parameter Source, into the array
228 -- pointed to by parameter Target, based on which of the following
229 -- two scenarios occurs first:
230 -- 1) copying the Terminator element, or
231 -- 2) copying the number of elements specified in parameter Limit.
232 -- Note: Terminator element must be copied to Target, as well as
233 -- all array elements prior to the terminator element.
234
235 if TC_Ch_Array = Ch_Array then
236 Report.Failed("The two char arrays are equivalent prior to the " &
237 "call to Copy_Terminated_Array - 1");
238 end if;
239
240
241 -- Case 1: Copying the Terminator Element. (Default terminator)
242
243 Char_Pointers.Copy_Terminated_Array(Source => Char_Ptr,
244 Target => TC_Char_Ptr);
245
246 if TC_Ch_Array /= Ch_Array then
247 Report.Failed("The two char arrays are not equal following the " &
248 "call to Copy_Terminated_Array, case of copying " &
249 "the Terminator Element, using default terminator");
250 end if;
251
252 -- Reset the Target Pointer array.
253
254 TC_Ch_Array := Interfaces.C.To_C(Blank_String, True);
255 TC_Char_Ptr := TC_Ch_Array(0)'Access;
256
257 if TC_Ch_Array = Ch_Array then
258 Report.Failed("The two char arrays are equivalent prior to the " &
259 "call to Copy_Terminated_Array - 2");
260 end if;
261
262
263 -- Case 2: Copying the Terminator Element. (Non-Default terminator)
264
265 TC_char := 'b'; -- Second char in char_array pointed to by Char_Ptr
266 Char_Pointers.Copy_Terminated_Array(Source => Char_Ptr,
267 Target => TC_Char_Ptr,
268 Terminator => TC_char);
269
270 if TC_Ch_Array(0) /= Ch_Array(0) or -- Initial value modified.
271 TC_Ch_Array(1) /= Ch_Array(1) or -- Initial value modified.
272 TC_Ch_Array(2) = Ch_Array(2) or -- Initial value not modified.
273 TC_Ch_Array(5) = Ch_Array(5) or -- Initial value not modified.
274 TC_Ch_Array(15) = Ch_Array(15) or -- Initial value not modified.
275 TC_Ch_Array(25) = Ch_Array(25) -- Initial value not modified.
276 then
277 Report.Failed("The appropriate portions of the two char arrays " &
278 "are not equal following the call to " &
279 "Copy_Terminated_Array, case of copying the " &
280 "Terminator Element, using non-default terminator");
281 end if;
282
283
284 if TC_Short_Array = Short_Array then
285 Report.Failed("The two short int arrays are equivalent prior " &
286 "to the call to Copy_Terminated_Array - 1");
287 end if;
288
289 Short_Pointers.Copy_Terminated_Array(Source => Short_Ptr,
290 Target => TC_Short_Ptr,
291 Terminator => 2);
292
293 if TC_Short_Array(0) /= Short_Array(0) or
294 TC_Short_Array(1) /= Short_Array(1) or
295 TC_Short_Array(2) /= Short_Array(2) or
296 TC_Short_Array(3) /= 100 -- Initial value not modified.
297 then
298 Report.Failed("The appropriate portions of the two short int " &
299 "arrays are not equal following the call to " &
300 "Copy_Terminated_Array, case of copying the " &
301 "Terminator Element, using non-default terminator");
302 end if;
303
304
305 -- Case 3: Copying the number of elements specified in parameter Limit.
306
307 if TC_Short_Array = Short_Array then
308 Report.Failed("The two short int arrays are equivalent prior " &
309 "to the call to Copy_Terminated_Array - 2");
310 end if;
311
312 TC_ptrdiff_t := 5;
313
314 Short_Pointers.Copy_Terminated_Array(Source => Short_Ptr,
315 Target => TC_Short_Ptr,
316 Limit => TC_ptrdiff_t,
317 Terminator => Short_Terminator);
318
319 if TC_Short_Array(0) /= Short_Array(0) or
320 TC_Short_Array(1) /= Short_Array(1) or
321 TC_Short_Array(2) /= Short_Array(2) or
322 TC_Short_Array(3) /= Short_Array(3) or
323 TC_Short_Array(4) /= Short_Array(4) or
324 TC_Short_Array(5) /= 100 -- Initial value not modified.
325 then
326 Report.Failed("The appropriate portions of the two Short arrays " &
327 "are not equal following the call to " &
328 "Copy_Terminated_Array, case of copying the number " &
329 "of elements specified in parameter Limit");
330 end if;
331
332
333 -- Case 4: Copying the number of elements specified in parameter Limit,
334 -- which also happens to be the number of elements up to and
335 -- including the first terminator.
336
337 -- Reset initial values for the array that holds short int values.
338
339 for i in Min_Array_Size..Max_Array_Size loop
340 Short_Array(i) := Interfaces.C.short(i);
341 TC_Short_Array(i) := 100;
342 end loop;
343
344 if TC_Short_Array = Short_Array then
345 Report.Failed("The two short int arrays are equivalent prior " &
346 "to the call to Copy_Terminated_Array - 3");
347 end if;
348
349 TC_ptrdiff_t := 3; -- Specifies three elements to be copied.
350 Short_Terminator := 2; -- Value held in Short_Array third element,
351 -- will serve as the "terminator" element.
352
353 Short_Pointers.Copy_Terminated_Array(Source => Short_Ptr,
354 Target => TC_Short_Ptr,
355 Limit => TC_ptrdiff_t,
356 Terminator => Short_Terminator);
357
358 if TC_Short_Array(0) /= Short_Array(0) or -- First element copied.
359 TC_Short_Array(1) /= Short_Array(1) or -- Second element copied.
360 TC_Short_Array(2) /= Short_Array(2) or -- Third element copied.
361 TC_Short_Array(3) /= 100 -- Initial value of fourth element
362 then -- not modified.
363 Report.Failed("The appropriate portions of the two Short arrays " &
364 "are not equal following the call to " &
365 "Copy_Terminated_Array, case of copying the number " &
366 "of elements specified in parameter " &
367 "Limit, which also happens to be the number of " &
368 "elements up to and including the first terminator");
369 end if;
370
371
372
373 -- Check that procedure Copy_Terminated_Array will propagate
374 -- Dereference_Error if either the Source or Target parameter is null.
375
376 Char_Ptr := null;
377 begin
378 Char_Pointers.Copy_Terminated_Array(Char_Ptr, TC_Char_Ptr);
379 Report.Failed("Dereference_Error not raised by call to " &
380 "Copy_Terminated_Array with null Source parameter");
381 if TC_Char_Ptr = null then -- To avoid optimization.
382 Report.Comment("This should never be printed");
383 end if;
384 exception
385 when Dereference_Error => null; -- OK, expected exception.
386 when others =>
387 Report.Failed("Incorrect exception raised by call to " &
388 "Copy_Terminated_Array with null Source parameter");
389 end;
390
391 TC_Short_Ptr := null;
392 begin
393 Short_Pointers.Copy_Terminated_Array(Short_Ptr, TC_Short_Ptr);
394 Report.Failed("Dereference_Error not raised by call to " &
395 "Copy_Terminated_Array with null Target parameter");
396 if Short_Ptr = null then -- To avoid optimization.
397 Report.Comment("This should never be printed");
398 end if;
399 exception
400 when Dereference_Error => null; -- OK, expected exception.
401 when others =>
402 Report.Failed("Incorrect exception raised by call to " &
403 "Copy_Terminated_Array with null Target parameter");
404 end;
405
406
407
408 -- Check that the procedure Copy_Array will copy the array of
409 -- elements of length specified in parameter Length, referenced by
410 -- the Pointer parameter Source, into the array pointed to by
411 -- parameter Target.
412
413 -- Reinitialize Target arrays prior to test cases below.
414
415 TC_Ch_Array := Interfaces.C.To_C(Blank_String, True);
416
417 for i in Min_Array_Size..Max_Array_Size loop
418 TC_Short_Array(i) := 100;
419 end loop;
420
421 Char_Ptr := Ch_Array(0)'Access;
422 TC_Char_Ptr := TC_Ch_Array(0)'Access;
423 Short_Ptr := Short_Array(0)'Access;
424 TC_Short_Ptr := TC_Short_Array(0)'Access;
425
426 TC_ptrdiff_t := 4;
427
428 Char_Pointers.Copy_Array(Source => Char_Ptr,
429 Target => TC_Char_Ptr,
430 Length => TC_ptrdiff_t);
431
432 if TC_Ch_Array(0) /= Ch_Array(0) or
433 TC_Ch_Array(1) /= Ch_Array(1) or
434 TC_Ch_Array(2) /= Ch_Array(2) or
435 TC_Ch_Array(3) /= Ch_Array(3) or
436 TC_Ch_Array(4) = Ch_Array(4)
437 then
438 Report.Failed("Incorrect result from Copy_Array when using " &
439 "char pointer arguments, partial array copied");
440 end if;
441
442
443 TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) + 1;
444
445 Short_Pointers.Copy_Array(Short_Ptr, TC_Short_Ptr, TC_ptrdiff_t);
446
447 if TC_Short_Array /= Short_Array then
448 Report.Failed("Incorrect result from Copy_Array when using Short " &
449 "pointer arguments, entire array copied");
450 end if;
451
452
453
454 -- Check that procedure Copy_Array will propagate Dereference_Error
455 -- if either the Source or Target parameter is null.
456
457 Char_Ptr := null;
458 begin
459 Char_Pointers.Copy_Array(Char_Ptr, TC_Char_Ptr, TC_ptrdiff_t);
460 Report.Failed("Dereference_Error not raised by call to " &
461 "Copy_Array with null Source parameter");
462 if TC_Char_Ptr = null then -- To avoid optimization.
463 Report.Comment("This should never be printed");
464 end if;
465 exception
466 when Dereference_Error => null; -- OK, expected exception.
467 when others =>
468 Report.Failed("Incorrect exception raised by call to " &
469 "Copy_Array with null Source parameter");
470 end;
471
472 TC_Short_Ptr := null;
473 begin
474 Short_Pointers.Copy_Array(Short_Ptr, TC_Short_Ptr, TC_ptrdiff_t);
475 Report.Failed("Dereference_Error not raised by call to " &
476 "Copy_Array with null Target parameter");
477 if Short_Ptr = null then -- To avoid optimization.
478 Report.Comment("This should never be printed");
479 end if;
480 exception
481 when Dereference_Error => null; -- OK, expected exception.
482 when others =>
483 Report.Failed("Incorrect exception raised by call to " &
484 "Copy_Array with null Target parameter");
485 end;
486
487
488 -- Check that function Virtual_Length will propagate Dereference_Error
489 -- if the Source parameter is null.
490
491 Char_Ptr := null;
492 begin
493 TC_ptrdiff_t := Char_Pointers.Virtual_Length(Char_Ptr,
494 Terminator => TC_char);
495 Report.Failed("Dereference_Error not raised by call to " &
496 "Virtual_Length with null Source parameter");
497 if TC_ptrdiff_t = 100 then -- To avoid optimization.
498 Report.Comment("This should never be printed");
499 end if;
500 exception
501 when Dereference_Error => null; -- OK, expected exception.
502 when others =>
503 Report.Failed("Incorrect exception raised by call to " &
504 "Virtual_Length with null Source parameter");
505 end;
506
507
508 exception
509 when The_Error : others =>
510 Report.Failed ("The following exception was raised in the " &
511 "Test_Block: " & Exception_Name(The_Error));
512 end Test_Block;
513
514 Report.Result;
515
516 end CXB3016;