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.
25 -- CHECK THAT CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE,
26 -- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
27 -- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
28 -- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS,
29 -- WHERE AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
30 -- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
31 -- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
32 -- ONLY STATIC CASES ARE CHECKED HERE.
37 -- L.BROWN 7/15/86 1) ADDED ACCESS TYPES.
38 -- 2) DELETED "NULL INDEX RANGES, CONSTRAINT_ERROR
40 -- 3) DELETED ANY MENTION OF CASE STATEMENT CHOICES
41 -- AND VARIANT CHOICES IN THE ABOVE COMMENT.
42 -- EDS 7/16/98 AVOID OPTIMIZATION
49 TYPE WEEK
IS (SUN
, MON
, TUE
, WED
, THU
, FRI
, SAT
);
50 TYPE WEEK_ARRAY
IS ARRAY (WEEK
RANGE <>) OF WEEK
;
51 SUBTYPE WORK_WEEK
IS WEEK
RANGE MON
.. FRI
;
52 SUBTYPE MID_WEEK
IS WORK_WEEK
RANGE TUE
.. THU
;
54 TYPE INT_10
IS NEW INTEGER RANGE -10 .. 10;
55 TYPE I_10
IS NEW INT_10
;
56 SUBTYPE I_5
IS I_10
RANGE -5 .. 5;
57 TYPE I_5_ARRAY
IS ARRAY (I_5
RANGE <>) OF I_5
;
60 TEST
("C36104A", "CONSTRAINT_ERROR IS RAISED OR NOT IN STATIC "
61 & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
63 -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
67 TYPE A
IS ARRAY (I_5
RANGE 0 .. 6) OF I_5
;
68 -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
71 -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID
72 -- OPTIMIZATION OF SUBTYPE
73 A1
: A
:= (OTHERS => I_5
(IDENT_INT
(1)));
75 FAILED
("CONSTRAINT_ERROR NOT RAISED 1 " &
76 I_5
'IMAGE(A1
(1)) ); --USE A1
79 --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
81 WHEN OTHERS => FAILED
("UNHANDLED EXCEPTION RAISED 1");
84 WHEN CONSTRAINT_ERROR
=> NULL;
86 FAILED
("WRONG EXCEPTION RAISED 1");
90 FOR I
IN MID_WEEK
RANGE MON
.. MON
LOOP
91 FAILED
("CONSTRAINT_ERROR NOT RAISED 3");
93 FAILED
("CONSTRAINT_ERROR NOT RAISED 3");
95 WHEN CONSTRAINT_ERROR
=> NULL;
97 FAILED
("WRONG EXCEPTION RAISED 3");
102 TYPE P
IS ACCESS I_5_ARRAY
(I_5
RANGE 0 .. 6);
103 -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
107 -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID
108 -- OPTIMIZATION OF TYPE
109 PA1
: PA
:= NEW I_5_ARRAY
'(0 .. I_5(IDENT_INT(6)) =>
112 FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " &
113 I_5'IMAGE(PA1(1))); --USE PA1
116 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
119 WHEN CONSTRAINT_ERROR => NULL;
121 FAILED ("WRONG EXCEPTION RAISED 4");
125 W : WEEK_ARRAY (MID_WEEK);
127 W := (MID_WEEK RANGE MON .. WED => WED);
128 -- CONSTRAINT_ERROR RAISED.
129 FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " &
130 MID_WEEK'IMAGE(W(WED))); --USE W
132 WHEN CONSTRAINT_ERROR => NULL;
134 FAILED ("WRONG EXCEPTION RAISED 7");
138 W : WEEK_ARRAY (WORK_WEEK);
140 W := (W'RANGE => WED); -- OK.
141 W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
142 FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " &
143 MID_WEEK'IMAGE(W(WED))); --USE W
145 WHEN CONSTRAINT_ERROR => NULL;
147 FAILED ("WRONG EXCEPTION RAISED 8");
152 W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
153 -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
155 W := (W'RANGE => WED); -- OK.
156 FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " &
157 MID_WEEK'IMAGE(W(WED))); --USE W
159 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 9");
162 WHEN CONSTRAINT_ERROR => NULL;
164 FAILED ("WRONG EXCEPTION RAISED 9");
169 TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. TUE);
170 -- RAISES CONSTRAINT_ERROR.
173 W1 : W := (OTHERS => WED);
175 FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " &
176 MID_WEEK'IMAGE(W1(WED))); --USE W1
179 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 10");
182 WHEN CONSTRAINT_ERROR => NULL;
184 FAILED ("WRONG EXCEPTION RAISED 10");
189 SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. WED);
190 -- RAISES CONSTRAINT_ERROR.
193 W1 : W := (OTHERS => (WED));
195 FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " &
196 MID_WEEK'IMAGE(W1(WED))); --USE W1
199 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
202 WHEN CONSTRAINT_ERROR => NULL;
204 FAILED ("WRONG EXCEPTION RAISED 11");
207 -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
211 TYPE A IS ARRAY (I_5 RANGE -5 .. -6) OF I_5;
214 IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
215 FAILED ("'FIRST
OF NULL ARRAY INCORRECT
");
219 WHEN OTHERS => FAILED ("EXCEPTION RAISED
1");
223 FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
224 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
226 FOR I IN MID_WEEK RANGE FRI .. WED LOOP
227 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
229 FOR I IN MID_WEEK RANGE MON .. SUN LOOP
230 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
232 FOR I IN I_5 RANGE 10 .. -10 LOOP
233 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
235 FOR I IN I_5 RANGE 10 .. 9 LOOP
236 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
238 FOR I IN I_5 RANGE -10 .. -11 LOOP
239 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
241 FOR I IN I_5 RANGE -10 .. -20 LOOP
242 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
244 FOR I IN I_5 RANGE 6 .. 5 LOOP
245 FAILED("LOOP WAS EXECUTED
WITH NULL DISCRETE
/INDEX RANGES
");
248 WHEN OTHERS => FAILED ("EXCEPTION RAISED
3");
253 TYPE P IS ACCESS I_5_ARRAY (-5 .. -6);
254 PA1 : P := NEW I_5_ARRAY (-5 .. -6);
256 IF PA1'LENGTH /= IDENT_INT(0) THEN
257 FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
262 FAILED ("EXCEPTION RAISED 5");
266 TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
267 SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
268 W : NARR(SNARR) := (1,2);
270 IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
271 FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
274 WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
278 W : WEEK_ARRAY (MID_WEEK);
280 W := (W'RANGE => WED); -- OK.
281 W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
283 WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
288 W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
290 IF (W'FIRST /= MON) THEN
291 FAILED ("'FIRST
OF NULL ARRAY INCORRECT
");
295 WHEN OTHERS => FAILED ("EXCEPTION RAISED
9");
300 TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
303 IF (W1'FIRST /= TUE) THEN
304 FAILED ("'FIRST OF NULL ARRAY INCORRECT");
308 WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
313 SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
316 IF (W1'FIRST /= TUE) THEN
317 FAILED ("'FIRST
OF NULL ARRAY INCORRECT
");
321 WHEN OTHERS => FAILED ("EXCEPTION RAISED
12");
324 -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
334 FAILED ("INCORRECT
'IN' EVALUATION
1");
337 IF INTEGER'(0) IN 10 .. -10
338 OR INTEGER'(0) IN 10 .. 9
339 OR INTEGER'(0) IN -10 .. -11
340 OR INTEGER'(0) IN -10 .. -20
341 OR INTEGER'(0) IN 6 .. 5
342 OR INTEGER'(0) IN 5 .. 3
343 OR INTEGER'(0) IN 7 .. 3
345 FAILED ("INCORRECT
'IN' EVALUATION
2");
348 IF WED NOT IN THU .. TUE
349 AND INTEGER'(0) NOT IN 4 .. -4
351 ELSE FAILED ("INCORRECT
'NOT IN' EVALUATION
");
354 WHEN OTHERS => FAILED ("EXCEPTION RAISED
52");