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 THE BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED
26 -- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
29 -- A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
32 -- B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
33 -- INDEX SUBTYPE FOR NULL RANGES.
35 -- C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
36 -- BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS
37 -- RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
40 -- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X
41 -- *** remove incompatibilities associated with the transition -- 9X
42 -- *** to Ada 9X. -- 9X
46 -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
56 TEST
("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
57 "DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
62 SUBTYPE ST1
IS INTEGER RANGE 10 .. 15;
63 SUBTYPE ST2
IS INTEGER RANGE 1 .. 5;
65 TYPE T1
IS ARRAY (ST1
RANGE <>) OF INTEGER;
66 TYPE T2
IS ARRAY (ST2
RANGE <>, ST1
RANGE <>) OF INTEGER;
74 PROCEDURE PROC1
(A
: T1
) IS
76 IF A
'FIRST /= 12 OR A
'LAST /= 10 THEN
77 FAILED
("CASE A1 : INCORRECT BOUNDS");
83 PROC1
((12 .. 10 => -2));
88 FAILED
("CASE A1 : EXCEPTION RAISED");
94 PROCEDURE PROC1
(A
: STRING) IS
96 IF A
'FIRST /= 5 OR A
'LAST /= 2 THEN
97 FAILED
("CASE A2 : INCORRECT BOUNDS");
103 PROC1
((5 .. 2 => 'E'));
108 FAILED
("CASE A2 : EXCEPTION RAISED");
118 PROCEDURE PROC1
(A
: T1
; L
, U
: INTEGER) IS
120 IF A
'FIRST /= L
OR A
'LAST /= U
THEN
121 FAILED
("CASE B1 : INCORRECT BOUNDS");
129 PROC1
((5 .. INTEGER'FIRST => -2),
134 WHEN CONSTRAINT_ERROR
=>
135 FAILED
("CASE B1A : CONSTRAINT_ERROR " &
136 "RAISED FOR NULL RANGE");
138 FAILED
("CASE B1A : EXCEPTION RAISED");
144 PROC1
((IDENT_INT
(6) .. 3 => -2),6,3);
149 FAILED
("CASE B1B : EXCEPTION RAISED");
157 PROCEDURE PROC1
(A
: STRING) IS
160 A
'LAST /= INTEGER'FIRST THEN
161 FAILED
("CASE B2 : INCORRECT BOUNDS");
167 PROC1
((1 .. INTEGER'FIRST => ' '));
172 FAILED
("CASE B2 : EXCEPTION RAISED");
182 PROCEDURE PROC1
(A
: T2
) IS
184 IF A
'FIRST(1) /= 5 OR A
'LAST(1) /= 3 OR
185 A
'FIRST(2) /= INTEGER'LAST-1 OR
186 A
'LAST(2) /= INTEGER'LAST THEN
187 FAILED
("CASE C1 : INCORRECT BOUNDS");
194 (IDENT_INT
(INTEGER'LAST-1) ..
195 IDENT_INT
(INTEGER'LAST) => -2)));
196 FAILED
("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
200 WHEN CONSTRAINT_ERROR
=>
204 FAILED
("CASE C1 : EXCEPTION RAISED");
210 PROCEDURE PROC1
(A
: T2
) IS
212 IF A
'FIRST(1) /= INTEGER'FIRST OR
213 A
'LAST(1) /= INTEGER'FIRST+1 OR
214 A
'FIRST(2) /= 14 OR A
'LAST(2) /= 11 THEN
215 FAILED
("CASE C2 : INCORRECT BOUNDS");
221 PROC1
((IDENT_INT
(INTEGER'FIRST) ..
222 IDENT_INT
(INTEGER'FIRST+1) =>
223 (14 .. IDENT_INT
(11) => -2)));
224 FAILED
("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
228 WHEN CONSTRAINT_ERROR
=>
232 FAILED
("CASE C2 : EXCEPTION RAISED");