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 -- FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE
27 -- IS A NON-LIMITED TYPE:
28 -- CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
29 -- THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
31 -- CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
32 -- IMPOSED ON THE DERIVED SUBTYPE.
35 -- JRK 9/17/86 CREATED ORIGINAL TEST.
37 WITH REPORT
; USE REPORT
;
41 SUBTYPE COMPONENT
IS INTEGER;
45 FIRST
: CONSTANT := 0;
46 LAST
: CONSTANT := 10;
48 SUBTYPE INDEX
IS INTEGER RANGE FIRST
.. LAST
;
50 TYPE PARENT
IS ARRAY (INDEX
RANGE <>, INDEX
RANGE <>) OF
53 FUNCTION CREATE
( F1
, L1
: INDEX
;
56 DUMMY
: PARENT
-- TO RESOLVE OVERLOADING.
63 TYPE T
IS NEW PARENT
(IDENT_INT
(4) .. IDENT_INT
(5),
64 IDENT_INT
(6) .. IDENT_INT
(8));
66 SUBTYPE SUBPARENT
IS PARENT
(4 .. 5, 6 .. 8);
68 TYPE S
IS NEW SUBPARENT
;
70 X
: T
:= (OTHERS => (OTHERS => 2));
71 Y
: S
:= (OTHERS => (OTHERS => 2));
82 A
: PARENT
(F1
.. L1
, F2
.. L2
);
85 FOR I
IN F1
.. L1
LOOP
86 FOR J
IN F2
.. L2
LOOP
97 TEST
("C34005O", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
98 "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
99 "WHEN THE DERIVED TYPE DEFINITION IS " &
100 "CONSTRAINED. ALSO CHECK THAT ANY CONSTRAINT " &
101 "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
102 "ON THE DERIVED SUBTYPE. CHECK FOR DERIVED " &
103 "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
104 "TYPE IS A NON-LIMITED TYPE");
106 -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
109 IF CREATE
(6, 9, 2, 3, 1, X
) /=
110 ((1, 2), (3, 4), (5, 6), (7, 8)) OR
111 CREATE
(6, 9, 2, 3, 1, Y
) /=
112 ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
113 FAILED
("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
117 WHEN CONSTRAINT_ERROR
=>
118 FAILED
("CALL TO CREATE RAISED CONSTRAINT_ERROR");
120 FAILED
("CALL TO CREATE RAISED EXCEPTION");
123 IF ((1, 2), (3, 4), (5, 6), (7, 8)) IN T
OR
124 ((1, 2), (3, 4), (5, 6), (7, 8)) IN S
THEN
125 FAILED
("INCORRECT ""IN""");
128 -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
130 IF T
'FIRST /= 4 OR T
'LAST /= 5 OR
131 S
'FIRST /= 4 OR S
'LAST /= 5 OR
132 T
'FIRST (2) /= 6 OR T
'LAST (2) /= 8 OR
133 S
'FIRST (2) /= 6 OR S
'LAST (2) /= 8 THEN
134 FAILED
("INCORRECT 'FIRST OR 'LAST");
138 X
:= ((1, 2, 3), (4, 5, 6));
139 Y
:= ((1, 2, 3), (4, 5, 6));
140 IF PARENT
(X
) /= PARENT
(Y
) THEN -- USE X AND Y.
141 FAILED
("INCORRECT CONVERSION TO PARENT");
145 FAILED
("EXCEPTION RAISED BY OK ASSIGNMENT");
149 X
:= (4 => (6 .. 8 => 0));
150 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
151 "X := (4 => (6 .. 8 => 0))");
152 IF X
= (4 => (6 .. 8 => 0)) THEN -- USE X.
153 COMMENT
("X ALTERED -- " &
154 "X := (4 => (6 .. 8 => 0))");
157 WHEN CONSTRAINT_ERROR
=>
160 FAILED
("WRONG EXCEPTION RAISED -- " &
161 "X := (4 => (6 .. 8 => 0))");
165 X
:= (4 .. 6 => (6 .. 8 => 0));
166 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
167 "X := (4 .. 6 => (6 .. 8 => 0))");
168 IF X
= (4 .. 6 => (6 .. 8 => 0)) THEN -- USE X.
169 COMMENT
("X ALTERED -- " &
170 "X := (4 .. 6 => (6 .. 8 => 0))");
173 WHEN CONSTRAINT_ERROR
=>
176 FAILED
("WRONG EXCEPTION RAISED -- " &
177 "X := (4 .. 6 => (6 .. 8 => 0))");
181 X
:= (4 .. 5 => (6 .. 7 => 0));
182 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
183 "X := (4 .. 5 => (6 .. 7 => 0))");
184 IF X
= (4 .. 5 => (6 .. 7 => 0)) THEN -- USE X.
185 COMMENT
("X ALTERED -- " &
186 "X := (4 .. 5 => (6 .. 7 => 0))");
189 WHEN CONSTRAINT_ERROR
=>
192 FAILED
("WRONG EXCEPTION RAISED -- " &
193 "X := (4 .. 5 => (6 .. 7 => 0))");
197 X
:= (4 .. 5 => (6 .. 9 => 0));
198 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
199 "X := (4 .. 5 => (6 .. 9 => 0))");
200 IF X
= (4 .. 5 => (6 .. 9 => 0)) THEN -- USE X.
201 COMMENT
("X ALTERED -- " &
202 "X := (4 .. 5 => (6 .. 9 => 0))");
205 WHEN CONSTRAINT_ERROR
=>
208 FAILED
("WRONG EXCEPTION RAISED -- " &
209 "X := (4 .. 5 => (6 .. 9 => 0))");
213 Y
:= (4 => (6 .. 8 => 0));
214 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
215 "Y := (4 => (6 .. 8 => 0))");
216 IF Y
= (4 => (6 .. 8 => 0)) THEN -- USE Y.
217 COMMENT
("Y ALTERED -- " &
218 "Y := (4 => (6 .. 8 => 0))");
221 WHEN CONSTRAINT_ERROR
=>
224 FAILED
("WRONG EXCEPTION RAISED -- " &
225 "Y := (4 => (6 .. 8 => 0))");
229 Y
:= (4 .. 6 => (6 .. 8 => 0));
230 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
231 "Y := (4 .. 6 => (6 .. 8 => 0))");
232 IF Y
= (4 .. 6 => (6 .. 8 => 0)) THEN -- USE Y.
233 COMMENT
("Y ALTERED -- " &
234 "Y := (4 .. 6 => (6 .. 8 => 0))");
237 WHEN CONSTRAINT_ERROR
=>
240 FAILED
("WRONG EXCEPTION RAISED -- " &
241 "Y := (4 .. 6 => (6 .. 8 => 0))");
245 Y
:= (4 .. 5 => (6 .. 7 => 0));
246 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
247 "Y := (4 .. 5 => (6 .. 7 => 0))");
248 IF Y
= (4 .. 5 => (6 .. 7 => 0)) THEN -- USE Y.
249 COMMENT
("Y ALTERED -- " &
250 "Y := (4 .. 5 => (6 .. 7 => 0))");
253 WHEN CONSTRAINT_ERROR
=>
256 FAILED
("WRONG EXCEPTION RAISED -- " &
257 "Y := (4 .. 5 => (6 .. 7 => 0))");
261 Y
:= (4 .. 5 => (6 .. 9 => 0));
262 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
263 "Y := (4 .. 5 => (6 .. 9 => 0))");
264 IF Y
= (4 .. 5 => (6 .. 9 => 0)) THEN -- USE Y.
265 COMMENT
("Y ALTERED -- " &
266 "Y := (4 .. 5 => (6 .. 9 => 0))");
269 WHEN CONSTRAINT_ERROR
=>
272 FAILED
("WRONG EXCEPTION RAISED -- " &
273 "Y := (4 .. 5 => (6 .. 9 => 0))");