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 ONE-DIMENSIONAL ARRAY TYPES
28 -- WHOSE COMPONENT TYPE IS A NON-LIMITED, NON-DISCRETE TYPE.
31 -- JRK 9/10/86 CREATED ORIGINAL TEST.
32 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
34 WITH SYSTEM
; USE SYSTEM
;
35 WITH REPORT
; USE REPORT
;
39 SUBTYPE COMPONENT
IS FLOAT;
43 FIRST
: CONSTANT := 0;
44 LAST
: CONSTANT := 100;
46 SUBTYPE INDEX
IS INTEGER RANGE FIRST
.. LAST
;
48 TYPE PARENT
IS ARRAY (INDEX
RANGE <>) OF COMPONENT
;
50 FUNCTION CREATE
( F
, L
: INDEX
;
52 DUMMY
: PARENT
-- TO RESOLVE OVERLOADING.
59 TYPE T
IS NEW PARENT
(IDENT_INT
(5) .. IDENT_INT
(7));
61 TYPE ARRT
IS ARRAY (INTEGER RANGE <>) OF COMPONENT
;
62 SUBTYPE ARR
IS ARRT
(2 .. 4);
64 X
: T
:= (OTHERS => 2.0);
65 W
: PARENT
(5 .. 7) := (OTHERS => 2.0);
68 U
: ARR
:= (OTHERS => C
);
71 PROCEDURE A
(X
: ADDRESS
) IS
73 B
:= IDENT_BOOL
(TRUE);
76 FUNCTION V
RETURN T
IS
101 FUNCTION IDENT
(X
: T
) RETURN T
IS
103 IF EQUAL
(X
'LENGTH, X
'LENGTH) THEN
104 RETURN X
; -- ALWAYS EXECUTED.
106 RETURN (OTHERS => -1.0);
110 TEST
("C34005A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
111 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
112 "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
113 "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
115 X
:= IDENT
((1.0, 2.0, 3.0));
116 IF X
/= (1.0, 2.0, 3.0) THEN
117 FAILED
("INCORRECT :=");
120 IF T
'(X) /= (1.0, 2.0, 3.0) THEN
121 FAILED ("INCORRECT QUALIFICATION");
124 IF T (X) /= (1.0, 2.0, 3.0) THEN
125 FAILED ("INCORRECT SELF CONVERSION");
129 W := (1.0, 2.0, 3.0);
131 IF T (W) /= (1.0, 2.0, 3.0) THEN
132 FAILED ("INCORRECT CONVERSION FROM PARENT");
136 IF PARENT (X) /= (1.0, 2.0, 3.0) OR
137 PARENT (CREATE (2, 3, 4.0, X)) /= (4.0, 5.0) THEN
138 FAILED ("INCORRECT CONVERSION TO PARENT");
141 WHEN CONSTRAINT_ERROR =>
142 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
144 FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
148 U := (1.0, 2.0, 3.0);
150 IF T (U) /= (1.0, 2.0, 3.0) THEN
151 FAILED ("INCORRECT CONVERSION FROM ARRAY");
155 IF ARR (X) /= (1.0, 2.0, 3.0) OR
156 ARRT (CREATE (1, 2, 3.0, X)) /= (3.0, 4.0) THEN
157 FAILED ("INCORRECT CONVERSION TO ARRAY");
160 WHEN CONSTRAINT_ERROR =>
161 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
163 FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
166 IF IDENT ((1.0, 2.0, 3.0)) /= (1.0, 2.0, 3.0) OR
168 FAILED ("INCORRECT AGGREGATE");
172 IF X (IDENT_INT (5)) /= 1.0 OR
173 CREATE (2, 3, 4.0, X) (3) /= 5.0 THEN
174 FAILED ("INCORRECT INDEX (VALUE)");
177 WHEN CONSTRAINT_ERROR =>
178 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
180 FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
183 X (IDENT_INT (7)) := 4.0;
184 IF X /= (1.0, 2.0, 4.0) THEN
185 FAILED ("INCORRECT INDEX (ASSIGNMENT)");
189 X := IDENT ((1.0, 2.0, 3.0));
190 IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2.0, 3.0) OR
191 CREATE (1, 4, 4.0, X) (1 .. 3) /= (4.0, 5.0, 6.0) THEN
192 FAILED ("INCORRECT SLICE (VALUE)");
195 WHEN CONSTRAINT_ERROR =>
196 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
198 FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
201 X (IDENT_INT (5) .. IDENT_INT (6)) := (4.0, 5.0);
202 IF X /= (4.0, 5.0, 3.0) THEN
203 FAILED ("INCORRECT SLICE (ASSIGNMENT)");
206 X := IDENT ((1.0, 2.0, 3.0));
207 IF X = IDENT ((1.0, 2.0, 4.0)) OR X = (1.0, 2.0) THEN
208 FAILED ("INCORRECT =");
211 IF X /= IDENT ((1.0, 2.0, 3.0)) OR NOT (X /= (2.0, 3.0)) THEN
212 FAILED ("INCORRECT /=");
215 IF NOT (X IN T) OR (1.0, 2.0) IN T THEN
216 FAILED ("INCORRECT ""IN""");
219 IF X NOT IN T OR NOT ((1.0, 2.0) NOT IN T) THEN
220 FAILED ("INCORRECT ""NOT IN""");
224 IF X & (4.0, 5.0, 6.0) /= (1.0, 2.0, 3.0, 4.0, 5.0, 6.0) OR
225 CREATE (2, 3, 2.0, X) & (4.0, 5.0) /=
226 (2.0, 3.0, 4.0, 5.0) THEN
227 FAILED ("INCORRECT & (ARRAY, ARRAY)");
230 WHEN CONSTRAINT_ERROR =>
231 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
233 FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
237 IF X & 4.0 /= (1.0, 2.0, 3.0, 4.0) OR
238 CREATE (2, 3, 2.0, X) & 4.0 /= (2.0, 3.0, 4.0) THEN
239 FAILED ("INCORRECT & (ARRAY, COMPONENT)");
242 WHEN CONSTRAINT_ERROR =>
243 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
245 FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
249 IF 4.0 & X /= (4.0, 1.0, 2.0, 3.0) OR
250 2.0 & CREATE (2, 3, 3.0, X) /= (2.0, 3.0, 4.0) THEN
251 FAILED ("INCORRECT & (COMPONENT, ARRAY)");
254 WHEN CONSTRAINT_ERROR =>
255 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
257 FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
265 IF C & 3.0 /= CREATE (2, 3, 2.0, X) THEN
266 FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
269 WHEN CONSTRAINT_ERROR =>
270 FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
272 FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
278 FAILED ("INCORRECT 'ADDRESS
");
282 FAILED ("INCORRECT
TYPE'FIRST");
286 FAILED ("INCORRECT OBJECT
'FIRST");
290 FAILED ("INCORRECT VALUE
'FIRST");
293 IF T'FIRST (N) /= 5 THEN
294 FAILED ("INCORRECT
TYPE'FIRST (N
)");
297 IF X'FIRST (N) /= 5 THEN
298 FAILED ("INCORRECT OBJECT
'FIRST (N
)");
301 IF V'FIRST (N) /= 5 THEN
302 FAILED ("INCORRECT VALUE
'FIRST (N
)");
306 FAILED ("INCORRECT
TYPE'LAST");
310 FAILED ("INCORRECT OBJECT
'LAST");
314 FAILED ("INCORRECT VALUE
'LAST");
317 IF T'LAST (N) /= 7 THEN
318 FAILED ("INCORRECT
TYPE'LAST (N
)");
321 IF X'LAST (N) /= 7 THEN
322 FAILED ("INCORRECT OBJECT
'LAST (N
)");
325 IF V'LAST (N) /= 7 THEN
326 FAILED ("INCORRECT VALUE
'LAST (N
)");
329 IF T'LENGTH /= 3 THEN
330 FAILED ("INCORRECT
TYPE'LENGTH");
333 IF X'LENGTH /= 3 THEN
334 FAILED ("INCORRECT OBJECT
'LENGTH");
337 IF V'LENGTH /= 3 THEN
338 FAILED ("INCORRECT VALUE
'LENGTH");
341 IF T'LENGTH (N) /= 3 THEN
342 FAILED ("INCORRECT
TYPE'LENGTH (N
)");
345 IF X'LENGTH (N) /= 3 THEN
346 FAILED ("INCORRECT OBJECT
'LENGTH (N
)");
349 IF V'LENGTH (N) /= 3 THEN
350 FAILED ("INCORRECT VALUE
'LENGTH (N
)");
354 Y : PARENT (T'RANGE);
356 IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
357 FAILED ("INCORRECT
TYPE'RANGE");
362 Y : PARENT (X'RANGE);
364 IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
365 FAILED ("INCORRECT OBJECT
'RANGE");
370 Y : PARENT (V'RANGE);
372 IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
373 FAILED ("INCORRECT VALUE
'RANGE");
378 Y : PARENT (T'RANGE (N));
380 IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
381 FAILED ("INCORRECT
TYPE'RANGE (N
)");
386 Y : PARENT (X'RANGE (N));
388 IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
389 FAILED ("INCORRECT OBJECT
'RANGE (N
)");
394 Y : PARENT (V'RANGE (N));
396 IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
397 FAILED ("INCORRECT VALUE
'RANGE (N
)");
401 IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
402 FAILED ("INCORRECT
TYPE'SIZE");
405 IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
406 FAILED ("INCORRECT OBJECT
'SIZE");