Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb3015.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 -- CXB3015.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 "+" and "-" functions with Pointer and ptrdiff_t
28 -- parameters that return Pointer values produce correct results,
29 -- based on the size of the array elements.
30 --
31 -- Check that the "-" function with two Pointer parameters that
32 -- returns a ptrdiff_t type parameter produces correct results,
33 -- based on the size of the array elements.
34 --
35 -- Check that each of the "+" and "-" functions above will
36 -- propagate Pointer_Error if a Pointer parameter is null.
37 --
38 -- Check that the Increment and Decrement procedures provide the
39 -- correct "pointer arithmetic" operations.
40 --
41 -- TEST DESCRIPTION:
42 -- This test checks that the functions "+" and "-", and the procedures
43 -- Increment and Decrement in the generic package Interfaces.C.Pointers
44 -- will allow the user to perform "pointer arithmetic" operations on
45 -- Pointer values.
46 -- Package Interfaces.C.Pointers is instantiated three times, for
47 -- short values, chars, and arrays of arrays. Pointers from each
48 -- instantiated package are then used to reference different elements
49 -- of array objects. Pointer arithmetic operations are performed on
50 -- these pointers, and the results of these operations are verified
51 -- against expected pointer positions along the referenced arrays.
52 -- The propagation of Pointer_Error is checked for when the function
53 -- Pointer parameter is null.
54 --
55 -- The following chart indicates the combinations of subprograms and
56 -- parameter types used in this test.
57 --
58 --
59 -- Short Char Array
60 -- --------------------------
61 -- "+" Pointer, ptrdiff_t | X | | X |
62 -- |--------------------------|
63 -- "+" ptrdiff_t, Pointer | X | | X |
64 -- |--------------------------|
65 -- "-" Pointer, ptrdiff_t | | X | X |
66 -- |--------------------------|
67 -- "-" Pointer, Pointer | | X | X |
68 -- |--------------------------|
69 -- Increment (Pointer) | X | | X |
70 -- |--------------------------|
71 -- Decrement (Pointer) | X | | X |
72 -- --------------------------
73 --
74 -- This test assumes that the following characters are all included
75 -- in the implementation defined type Interfaces.C.char:
76 -- ' ', and 'a'..'z'.
77 --
78 -- APPLICABILITY CRITERIA:
79 -- This test is applicable to all implementations that provide
80 -- package Interfaces.C.Pointers. If an implementation provides
81 -- package Interfaces.C.Pointers, this test must compile, execute, and
82 -- report "PASSED".
83 --
84 --
85 -- CHANGE HISTORY:
86 -- 26 Oct 95 SAIC Initial prerelease version.
87 -- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
88 -- 26 Oct 96 SAIC Incorporated reviewer comments.
89 -- 06 Mar 00 RLB Repaired so that array of arrays component
90 -- type is statically constrained. (C does not have
91 -- an analog to an array of dynamically constrained
92 -- arrays.)
93
94 with Report;
95 with Ada.Exceptions;
96 with Interfaces.C.Pointers; -- N/A => ERROR
97
98 procedure CXB3015 is
99 begin
100
101 Report.Test ("CXB3015", "Check that +, -, Increment, and Decrement " &
102 "subprograms in Package Interfaces.C.Pointers " &
103 "produce correct results");
104
105 Test_Block:
106 declare
107
108 use Ada.Exceptions;
109 use type Interfaces.C.short;
110 use type Interfaces.C.size_t, Interfaces.C.ptrdiff_t;
111 use type Interfaces.C.char, Interfaces.C.char_array;
112
113 TC_Count : Interfaces.C.size_t;
114 TC_Increment : Interfaces.C.ptrdiff_t;
115 TC_ptrdiff_t : Interfaces.C.ptrdiff_t;
116 TC_Short : Interfaces.C.short := 0;
117 TC_Verbose : Boolean := False;
118 Constant_Min_Array_Size : constant Interfaces.C.size_t := 0;
119 Constant_Max_Array_Size : constant Interfaces.C.size_t := 20;
120 Min_Array_Size : Interfaces.C.size_t := Interfaces.C.size_t(
121 Report.Ident_Int(Integer(Constant_Min_Array_Size)));
122 Max_Array_Size : Interfaces.C.size_t := Interfaces.C.size_t(
123 Report.Ident_Int(Integer(Constant_Max_Array_Size)));
124 Min_size_t,
125 Max_size_t : Interfaces.C.size_t;
126 Short_Terminator : Interfaces.C.short := Interfaces.C.short'Last;
127 Alphabet : constant String := "abcdefghijklmnopqrstuvwxyz";
128
129
130 type Short_Array_Type is
131 array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short;
132
133 type Constrained_Array_Type is
134 array (Min_Array_Size..Max_Array_Size) of aliased Interfaces.C.short;
135
136 type Static_Constrained_Array_Type is
137 array (Constant_Min_Array_Size .. Constant_Max_Array_Size) of
138 aliased Interfaces.C.short;
139
140 type Array_of_Arrays_Type is
141 array (Interfaces.C.size_t range <>) of aliased
142 Static_Constrained_Array_Type;
143
144
145 Short_Array : Short_Array_Type(Min_Array_Size..Max_Array_Size);
146
147 Constrained_Array : Constrained_Array_Type;
148
149 Terminator_Array : Static_Constrained_Array_Type :=
150 (others => Short_Terminator);
151
152 Ch_Array : Interfaces.C.char_array
153 (0..Interfaces.C.size_t(Alphabet'Length)) :=
154 Interfaces.C.To_C(Alphabet, True);
155
156 Array_of_Arrays : Array_of_Arrays_Type
157 (Min_Array_Size..Max_Array_Size);
158
159
160 package Short_Pointers is new
161 Interfaces.C.Pointers (Index => Interfaces.C.size_t,
162 Element => Interfaces.C.short,
163 Element_Array => Short_Array_Type,
164 Default_Terminator => Short_Terminator);
165
166 package Char_Pointers is new
167 Interfaces.C.Pointers (Interfaces.C.size_t,
168 Interfaces.C.char,
169 Element_Array => Interfaces.C.char_array,
170 Default_Terminator => Interfaces.C.nul);
171
172 package Array_Pointers is new
173 Interfaces.C.Pointers (Interfaces.C.size_t,
174 Static_Constrained_Array_Type,
175 Array_of_Arrays_Type,
176 Terminator_Array);
177
178
179 use Short_Pointers, Char_Pointers, Array_Pointers;
180
181 Short_Ptr : Short_Pointers.Pointer := Short_Array(0)'Access;
182 Char_Ptr : Char_Pointers.Pointer := Ch_Array(0)'Access;
183 Start_Char_Ptr : Char_Pointers.Pointer := Ch_Array(1)'Access;
184 End_Char_Ptr : Char_Pointers.Pointer := Ch_Array(10)'Access;
185 Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(0)'Access;
186 Start_Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(1)'Access;
187 End_Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(10)'Access;
188
189 begin
190
191 -- Provide initial values for the arrays that hold short int values.
192
193 for i in Min_Array_Size..Max_Array_Size-1 loop
194 Short_Array(i) := Interfaces.C.short(i);
195 for j in Min_Array_Size..Max_Array_Size loop
196 -- Initialize this "array of arrays" so that element (i)(0)
197 -- is different for each value of i.
198 Array_of_Arrays(i)(j) := TC_Short;
199 TC_Short := TC_Short + 1;
200 end loop;
201 end loop;
202
203 -- Set the final element of each array object to be the "terminator"
204 -- element used in the instantiations above.
205
206 Short_Array(Max_Array_Size) := Short_Terminator;
207 Array_of_Arrays(Max_Array_Size) := Terminator_Array;
208
209 -- Check starting pointer positions.
210
211 if Short_Ptr.all /= 0 or
212 Char_Ptr.all /= Ch_Array(0) or
213 Array_Ptr.all /= Array_of_Arrays(0)
214 then
215 Report.Failed("Incorrect initial value for the first " &
216 "Short_Array, Ch_Array, or Array_of_Array values");
217 end if;
218
219
220 -- Check that both versions of the "+" function with Pointer and
221 -- ptrdiff_t parameters, that return a Pointer value, produce correct
222 -- results, based on the size of the array elements.
223
224 for i in Min_Array_Size + 1 .. Max_Array_Size loop
225
226 if Integer(i)/2*2 /= Integer(i) then -- Odd numbered loops.
227 -- Pointer + ptrdiff_t, increment by 1.
228 Short_Ptr := Short_Ptr + 1;
229 else -- Even numbered loops.
230 -- ptrdiff_t + Pointer, increment by 1.
231 Short_Ptr := 1 + Short_Ptr;
232 end if;
233
234 if Short_Ptr.all /= Short_Array(i) then
235 Report.Failed("Incorrect value returned following use " &
236 "of the function +, incrementing by 1, " &
237 "array position : " & Integer'Image(Integer(i)));
238 if not TC_Verbose then
239 exit;
240 end if;
241 end if;
242 end loop;
243
244 Array_Ptr := Array_of_Arrays(Min_Array_Size)'Access;
245 TC_Count := Min_Array_Size;
246 TC_Increment := 3;
247 while TC_Count+Interfaces.C.size_t(TC_Increment) < Max_Array_Size loop
248
249 if Integer(TC_Count)/2*2 /= Integer(TC_Count) then
250 -- Odd numbered loops.
251 -- Pointer + ptrdiff_t, increment by 3.
252 Array_Ptr := Array_Pointers."+"(Array_Ptr, TC_Increment);
253 else
254 -- Odd numbered loops.
255 -- ptrdiff_t + Pointer, increment by 3.
256 Array_Ptr := Array_Pointers."+"(Left => TC_Increment,
257 Right => Array_Ptr);
258 end if;
259
260 if Array_Ptr.all /=
261 Array_of_Arrays(TC_Count+Interfaces.C.size_t(TC_Increment))
262 then
263 Report.Failed("Incorrect value returned following use " &
264 "of the function +, incrementing by " &
265 Integer'Image(Integer(TC_Increment)) &
266 ", array position : " &
267 Integer'Image(Integer(TC_Count) +
268 Integer(TC_Increment)));
269 if not TC_Verbose then
270 exit;
271 end if;
272 end if;
273
274 TC_Count := TC_Count + Interfaces.C.size_t(TC_Increment);
275 end loop;
276
277
278
279 -- Check that the "-" function with Pointer and ptrdiff_t parameters,
280 -- that returns a Pointer result, produces correct results, based
281 -- on the size of the array elements.
282
283 -- Set the pointer to the last element in the char_array, which is a
284 -- nul char.
285 Char_Ptr := Ch_Array(Interfaces.C.size_t(Alphabet'Length))'Access;
286
287 if Char_Ptr.all /= Interfaces.C.nul then
288 Report.Failed("Incorrect initial value for the last " &
289 "Ch_Array value");
290 end if;
291
292 Min_size_t := 1;
293 Max_size_t := Interfaces.C.size_t(Alphabet'Length);
294
295 for i in reverse Min_size_t..Max_size_t loop
296
297 -- Subtract 1 from the pointer; it should now point to the previous
298 -- element in the array.
299 Char_Ptr := Char_Ptr - 1;
300
301 if Char_Ptr.all /= Ch_Array(i-1) then
302 Report.Failed("Incorrect value returned following use " &
303 "of the function '-' with char element values, " &
304 "array position : " & Integer'Image(Integer(i-1)));
305 if not TC_Verbose then
306 exit;
307 end if;
308 end if;
309 end loop;
310
311 Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access;
312 TC_Count := Max_Array_Size;
313 TC_Increment := 3;
314 while TC_Count > Min_Array_Size+Interfaces.C.size_t(TC_Increment) loop
315
316 -- Decrement the pointer by 3.
317 Array_Ptr := Array_Pointers."-"(Array_Ptr, Right => 3);
318
319 if Array_Ptr.all /=
320 Array_of_Arrays(TC_Count - Interfaces.C.size_t(TC_Increment))
321 then
322 Report.Failed("Incorrect value returned following use " &
323 "of the function -, decrementing by " &
324 Integer'Image(Integer(TC_Increment)) &
325 ", array position : " &
326 Integer'Image(Integer(TC_Count-3)));
327 if not TC_Verbose then
328 exit;
329 end if;
330 end if;
331
332 TC_Count := TC_Count - Interfaces.C.size_t(TC_Increment);
333 end loop;
334
335
336
337 -- Check that the "-" function with two Pointer parameters, that
338 -- returns a ptrdiff_t type result, produces correct results,
339 -- based on the size of the array elements.
340
341 TC_ptrdiff_t := 9;
342 if Char_Pointers."-"(Left => End_Char_Ptr,
343 Right => Start_Char_Ptr) /= TC_ptrdiff_t
344 then
345 Report.Failed("Incorrect result from pointer-pointer " &
346 "subtraction - 1");
347 end if;
348
349 Start_Char_Ptr := Ch_Array(1)'Access;
350 End_Char_Ptr := Ch_Array(25)'Access;
351
352 TC_ptrdiff_t := 24;
353 if Char_Pointers."-"(End_Char_Ptr,
354 Right => Start_Char_Ptr) /= TC_ptrdiff_t
355 then
356 Report.Failed("Incorrect result from pointer-pointer " &
357 "subtraction - 2");
358 end if;
359
360 TC_ptrdiff_t := 9;
361 if Array_Pointers."-"(End_Array_Ptr,
362 Start_Array_Ptr) /= TC_ptrdiff_t
363 then
364 Report.Failed("Incorrect result from pointer-pointer " &
365 "subtraction - 3");
366 end if;
367
368 Start_Array_Ptr := Array_of_Arrays(Min_Array_Size)'Access;
369 End_Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access;
370
371 TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) -
372 Interfaces.C.ptrdiff_t(Min_Array_Size);
373 if End_Array_Ptr - Start_Array_Ptr /= TC_ptrdiff_t then
374 Report.Failed("Incorrect result from pointer-pointer " &
375 "subtraction - 4");
376 end if;
377
378
379
380 -- Check that the Increment procedure produces correct results,
381 -- based upon the size of the array elements.
382
383 Short_Ptr := Short_Array(0)'Access;
384
385 for i in Min_Array_Size + 1 .. Max_Array_Size loop
386 -- Increment the value of the Pointer; it should now point
387 -- to the next element in the array.
388 Increment(Ref => Short_Ptr);
389
390 if Short_Ptr.all /= Short_Array(i) then
391 Report.Failed("Incorrect value returned following use " &
392 "of the Procedure Increment on pointer to an " &
393 "array of short values, array position : " &
394 Integer'Image(Integer(i)));
395 if not TC_Verbose then
396 exit;
397 end if;
398 end if;
399 end loop;
400
401 Array_Ptr := Array_of_Arrays(0)'Access;
402
403 for i in Min_Array_Size + 1 .. Max_Array_Size loop
404 -- Increment the value of the Pointer; it should now point
405 -- to the next element in the array.
406 Increment(Array_Ptr);
407
408 if Array_Ptr.all /= Array_of_Arrays(i) then
409 Report.Failed("Incorrect value returned following use " &
410 "of the Procedure Increment on an array of " &
411 "arrays, array position : " &
412 Integer'Image(Integer(i)));
413 if not TC_Verbose then
414 exit;
415 end if;
416 end if;
417 end loop;
418
419
420 -- Check that the Decrement procedure produces correct results,
421 -- based upon the size of the array elements.
422
423 Short_Ptr := Short_Array(Max_Array_Size)'Access;
424
425 for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop
426 -- Decrement the value of the Pointer; it should now point
427 -- to the previous element in the array.
428 Decrement(Ref => Short_Ptr);
429
430 if Short_Ptr.all /= Short_Array(i) then
431 Report.Failed("Incorrect value returned following use " &
432 "of the Procedure Decrement on pointer to an " &
433 "array of short values, array position : " &
434 Integer'Image(Integer(i)));
435 if not TC_Verbose then
436 exit;
437 end if;
438 end if;
439 end loop;
440
441 Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access;
442
443 for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop
444 -- Decrement the value of the Pointer; it should now point
445 -- to the previous array element.
446 Decrement(Array_Ptr);
447
448 if Array_Ptr.all /= Array_of_Arrays(i) then
449 Report.Failed("Incorrect value returned following use " &
450 "of the Procedure Decrement on an array of " &
451 "arrays, array position : " &
452 Integer'Image(Integer(i)));
453 if not TC_Verbose then
454 exit;
455 end if;
456 end if;
457 end loop;
458
459
460
461 -- Check that each of the "+" and "-" functions above will
462 -- propagate Pointer_Error if a Pointer parameter is null.
463
464 begin
465 Short_Ptr := null;
466 Short_Ptr := Short_Ptr + 4;
467 Report.Failed("Pointer_Error not raised by Function + when " &
468 "the Pointer parameter is null");
469 if Short_Ptr /= null then -- To avoid optimization.
470 Report.Comment("This should never be printed");
471 end if;
472 exception
473 when Short_Pointers.Pointer_Error => null; -- OK, expected exception.
474 when others =>
475 Report.Failed("Unexpected exception raised by Function + " &
476 "when the Pointer parameter is null");
477 end;
478
479
480 begin
481 Char_Ptr := null;
482 Char_Ptr := Char_Ptr - 1;
483 Report.Failed("Pointer_Error not raised by Function - when " &
484 "the Pointer parameter is null");
485 if Char_Ptr /= null then -- To avoid optimization.
486 Report.Comment("This should never be printed");
487 end if;
488 exception
489 when Char_Pointers.Pointer_Error => null; -- OK, expected exception.
490 when others =>
491 Report.Failed("Unexpected exception raised by Function - " &
492 "when the Pointer parameter is null");
493 end;
494
495
496 begin
497 Array_Ptr := null;
498 Decrement(Array_Ptr);
499 Report.Failed("Pointer_Error not raised by Procedure Decrement " &
500 "when the Pointer parameter is null");
501 if Array_Ptr /= null then -- To avoid optimization.
502 Report.Comment("This should never be printed");
503 end if;
504 exception
505 when Array_Pointers.Pointer_Error => null; -- OK, expected exception.
506 when others =>
507 Report.Failed("Unexpected exception raised by Procedure " &
508 "Decrement when the Pointer parameter is null");
509 end;
510
511
512 exception
513 when The_Error : others =>
514 Report.Failed ("The following exception was raised in the " &
515 "Test_Block: " & Exception_Name(The_Error));
516 end Test_Block;
517
518 Report.Result;
519
520 end CXB3015;