3 -- Grant of Unlimited Rights
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
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.
26 -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
27 -- (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
28 -- ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS PART 1 OF 2 TESTS
29 -- WHICH COVER THE OBJECTIVE. THE SECOND PART IS IN TEST C34007V.
32 -- JRK 09/25/86 CREATED ORIGINAL TEST.
33 -- BCB 10/21/87 CHANGED HEADER TO STANDARD FORMAT. REVISED TEST SO
34 -- T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
35 -- BCB 09/26/88 REMOVED COMPARISON INVOLVING OBJECT SIZE.
36 -- BCB 04/12/90 SPLIT ORIGINAL TEST INTO C34007D.ADA AND
37 -- C34007V.ADA. PUT CHECK FOR 'STORAGE_SIZE IN
39 -- THS 09/18/90 REMOVED DECLARATION OF B, MADE THE BODY OF
40 -- PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
41 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
43 WITH SYSTEM
; USE SYSTEM
;
44 WITH REPORT
; USE REPORT
;
48 SUBTYPE COMPONENT
IS INTEGER;
50 TYPE DESIGNATED
IS ARRAY (NATURAL RANGE <>) OF COMPONENT
;
52 SUBTYPE SUBDESIGNATED
IS DESIGNATED
(IDENT_INT
(5) ..
57 TYPE PARENT
IS ACCESS DESIGNATED
;
63 TYPE T
IS NEW PARENT
(IDENT_INT
(5) .. IDENT_INT
(7));
65 X
: T
:= NEW SUBDESIGNATED
'(OTHERS => 2);
66 K : INTEGER := X'SIZE;
67 Y : T := NEW SUBDESIGNATED'(1, 2, 3);
68 W
: PARENT
:= NEW SUBDESIGNATED
'(OTHERS => 2);
72 PROCEDURE A (X : ADDRESS) IS
77 FUNCTION V RETURN T IS
79 RETURN NEW SUBDESIGNATED'(OTHERS => C
);
82 FUNCTION IDENT
(X
: T
) RETURN T
IS
85 EQUAL
(X
'LENGTH, X
'LENGTH) THEN
86 RETURN X
; -- ALWAYS EXECUTED.
88 RETURN NEW SUBDESIGNATED
;
92 TEST
("C34007D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
93 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
94 "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
95 "ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS " &
96 "PART 1 OF 2 TESTS WHICH COVER THE OBJECTIVE. " &
97 "THE SECOND PART IS IN TEST C34007V");
99 IF Y
= NULL OR ELSE Y
.ALL /= (1, 2, 3) THEN
100 FAILED
("INCORRECT INITIALIZATION");
105 FAILED
("INCORRECT :=");
109 FAILED ("INCORRECT QUALIFICATION");
113 FAILED ("INCORRECT SELF CONVERSION");
117 W := NEW SUBDESIGNATED'(1, 2, 3);
120 IF X
= NULL OR ELSE X
= Y
OR ELSE X
.ALL /= (1, 2, 3) THEN
121 FAILED
("INCORRECT CONVERSION FROM PARENT");
126 IF W
= NULL OR ELSE W
.ALL /= (1, 2, 3) OR ELSE T
(W
) /= Y
THEN
127 FAILED
("INCORRECT CONVERSION TO PARENT - 1");
130 IF IDENT
(NULL) /= NULL OR X
= NULL THEN
131 FAILED
("INCORRECT NULL");
134 X
:= IDENT
(NEW SUBDESIGNATED
'(1, 2, 3));
135 IF (X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3)) OR
136 X = NEW DESIGNATED'(1, 2) THEN
137 FAILED
("INCORRECT ALLOCATOR");
142 IF X
.ALL = (0, 0, 0) THEN
143 FAILED
("NO EXCEPTION FOR NULL.ALL - 1");
144 ELSE FAILED
("NO EXCEPTION FOR NULL.ALL - 2");
147 WHEN CONSTRAINT_ERROR
=>
150 FAILED
("WRONG EXCEPTION FOR NULL.ALL");
154 X
(IDENT_INT
(7)) := 4;
155 IF X
/= Y
OR Y
.ALL /= (1, 2, 4) THEN
156 FAILED
("INCORRECT INDEX (ASSIGNMENT)");
161 X
(IDENT_INT
(5) .. IDENT_INT
(6)) := (4, 5);
162 IF X
/= Y
OR Y
.ALL /= (4, 5, 3) THEN
163 FAILED
("INCORRECT SLICE (ASSIGNMENT)");
169 FAILED
("INCORRECT OBJECT'FIRST");
173 FAILED
("INCORRECT VALUE'FIRST");
176 IF X
'FIRST (N
) /= 5 THEN
177 FAILED
("INCORRECT OBJECT'FIRST (N)");
180 IF V
'FIRST (N
) /= 5 THEN
181 FAILED
("INCORRECT VALUE'FIRST (N)");
185 FAILED
("INCORRECT OBJECT'LAST");
189 FAILED
("INCORRECT VALUE'LAST");
192 IF X
'LAST (N
) /= 7 THEN
193 FAILED
("INCORRECT OBJECT'LAST (N)");
196 IF V
'LAST (N
) /= 7 THEN
197 FAILED
("INCORRECT VALUE'LAST (N)");
200 IF X
'LENGTH /= 3 THEN
201 FAILED
("INCORRECT OBJECT'LENGTH");
204 IF V
'LENGTH /= 3 THEN
205 FAILED
("INCORRECT VALUE'LENGTH");
208 IF X
'LENGTH (N
) /= 3 THEN
209 FAILED
("INCORRECT OBJECT'LENGTH (N)");
212 IF V
'LENGTH (N
) /= 3 THEN
213 FAILED
("INCORRECT VALUE'LENGTH (N)");
217 Y
: DESIGNATED
(X
'RANGE);
219 IF Y
'FIRST /= 5 OR Y
'LAST /= 7 THEN
220 FAILED
("INCORRECT OBJECT'RANGE");
225 Y
: DESIGNATED
(V
'RANGE);
227 IF Y
'FIRST /= 5 OR Y
'LAST /= 7 THEN
228 FAILED
("INCORRECT VALUE'RANGE");
233 Y
: DESIGNATED
(X
'RANGE (N
));
235 IF Y
'FIRST /= 5 OR Y
'LAST /= 7 THEN
236 FAILED
("INCORRECT OBJECT'RANGE (N)");
241 Y
: DESIGNATED
(V
'RANGE (N
));
243 IF Y
'FIRST /= 5 OR Y
'LAST /= 7 THEN
244 FAILED
("INCORRECT VALUE'RANGE (N)");
249 FAILED
("INCORRECT TYPE'SIZE");
253 IF T
'STORAGE_SIZE /= PARENT
'STORAGE_SIZE THEN
254 FAILED
("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
255 "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
258 WHEN PROGRAM_ERROR
=>
259 COMMENT
("PROGRAM_ERROR RAISED FOR " &
260 "UNDEFINED STORAGE_SIZE (AI-00608)");
262 FAILED
("UNEXPECTED EXCEPTION RAISED");