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 NOT RAISED BEFORE OR AFTER THE ENTRY
26 -- CALL FOR IN OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
27 -- FORM OF A TYPE CONVERSION. THE FOLLOWING CASES ARE TESTED:
29 -- (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
30 -- COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
31 -- FORMAL INDEX SUBTYPE.
32 -- (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
33 -- COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
35 -- (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
36 -- FORMAL INDEX SUBTYPE.
37 -- (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
38 -- FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
41 -- TMB 11/15/95 ELIMINATED INCOMPATIBILITY WITH ADA95
42 -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
44 WITH REPORT
; USE REPORT
;
48 TEST
("C95086E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
49 "BEFORE OR AFTER THE ENTRY CALL FOR IN OUT ARRAY " &
50 "PARAMETERS, WITH THE ACTUAL HAVING THE FORM OF A TYPE " &
53 ---------------------------------------------
57 SUBTYPE INDEX
IS INTEGER RANGE 1..5;
58 TYPE ARRAY_TYPE
IS ARRAY (INDEX
RANGE <>, INDEX
RANGE <>)
60 SUBTYPE FORMAL
IS ARRAY_TYPE
(1..3, 1..3);
61 SUBTYPE ACTUAL
IS ARRAY_TYPE
(1..3, 1..3);
62 AR
: ACTUAL
:= (1..3 => (1..3 => TRUE));
63 CALLED
: BOOLEAN := FALSE;
66 ENTRY E
(X
: IN OUT FORMAL
);
71 ACCEPT E
(X
: IN OUT FORMAL
) DO
76 FAILED
("EXCEPTION RAISED IN TASK - (A)");
84 WHEN CONSTRAINT_ERROR
=>
86 FAILED
("EXCEPTION RAISED BEFORE CALL - (A)");
88 FAILED
("EXCEPTION RAISED ON RETURN - (A)");
91 FAILED
("EXCEPTION RAISED - (A)");
94 ---------------------------------------------
98 SUBTYPE INDEX
IS INTEGER RANGE 1..3;
99 TYPE FORMAL
IS ARRAY (INDEX
, INDEX
) OF BOOLEAN;
100 TYPE ACTUAL
IS ARRAY (3..5, 3..5) OF BOOLEAN;
101 AR
: ACTUAL
:= (3..5 => (3..5 => FALSE));
102 CALLED
: BOOLEAN := FALSE;
105 ENTRY E
(X
: IN OUT FORMAL
);
110 ACCEPT E
(X
: IN OUT FORMAL
) DO
116 FAILED
("EXCEPTION RAISED IN TASK - (B)");
122 IF AR
(5, 5) /= TRUE THEN
123 FAILED
("INCORRECT RETURNED VALUE - (B)");
127 WHEN CONSTRAINT_ERROR
=>
129 FAILED
("EXCEPTION RAISED BEFORE CALL - (B)");
131 FAILED
("EXCEPTION RAISED ON RETURN - (B)");
134 FAILED
("EXCEPTION RAISED - (B)");
137 ---------------------------------------------
141 SUBTYPE INDEX
IS INTEGER RANGE 1..5;
142 TYPE ARRAY_TYPE
IS ARRAY (INDEX
RANGE <>, INDEX
RANGE <>)
144 SUBTYPE FORMAL
IS ARRAY_TYPE
(2..0, 1..3);
145 AR
: ARRAY_TYPE
(2..1, 1..3) := (2..1 => (1..3 => ' '));
146 CALLED
: BOOLEAN := FALSE;
149 ENTRY E
(X
: IN OUT FORMAL
);
154 ACCEPT E
(X
: IN OUT FORMAL
) DO
155 IF X
'LAST /= 0 AND X
'LAST(2) /= 3 THEN
156 FAILED
("WRONG BOUNDS PASSED - (C)");
159 X
:= (2..0 => (1..3 => 'A'));
163 FAILED
("EXCEPTION RAISED IN TASK - (C)");
169 IF AR
'LAST /= 1 AND AR
'LAST(2) /= 3 THEN
170 FAILED
("BOUNDS CHANGED - (C)");
174 WHEN CONSTRAINT_ERROR
=>
176 FAILED
("EXCEPTION RAISED BEFORE CALL - (C)");
178 FAILED
("EXCEPTION RAISED ON RETURN - (C)");
181 FAILED
("EXCEPTION RAISED - (C)");
184 ---------------------------------------------
188 SUBTYPE INDEX
IS INTEGER RANGE 1..3;
189 TYPE FORMAL
IS ARRAY (INDEX
RANGE 1..3, INDEX
RANGE 3..1)
191 TYPE ACTUAL
IS ARRAY (3..5, 5..3) OF CHARACTER;
192 AR
: ACTUAL
:= (3..5 => (5..3 => ' '));
193 CALLED
: BOOLEAN := FALSE;
196 ENTRY E
(X
: IN OUT FORMAL
);
201 ACCEPT E
(X
: IN OUT FORMAL
) DO
202 IF X
'LAST /= 3 AND X
'LAST(2) /= 1 THEN
203 FAILED
("WRONG BOUNDS PASSED - (D)");
206 X
:= (1..3 => (3..1 => 'A'));
210 FAILED
("EXCEPTION RAISED IN TASK - (D)");
216 IF AR
'LAST /= 5 AND AR
'LAST(2) /= 3 THEN
217 FAILED
("BOUNDS CHANGED - (D)");
221 WHEN CONSTRAINT_ERROR
=>
223 FAILED
("EXCEPTION RAISED BEFORE CALL - (D)");
225 FAILED
("EXCEPTION RAISED ON RETURN - (D)");
228 FAILED
("EXCEPTION RAISED - (D)");
231 ---------------------------------------------
235 SUBTYPE INDEX
IS INTEGER RANGE 1..3;
236 TYPE FORMAL
IS ARRAY (INDEX
RANGE <>, INDEX
RANGE <>)
238 TYPE ACTUAL
IS ARRAY (POSITIVE RANGE 5..2,
239 POSITIVE RANGE 1..3) OF CHARACTER;
240 AR
: ACTUAL
:= (5..2 => (1..3 => ' '));
241 CALLED
: BOOLEAN := FALSE;
244 ENTRY E
(X
: IN OUT FORMAL
);
249 ACCEPT E
(X
: IN OUT FORMAL
) DO
250 IF X
'LAST /= 2 AND X
'LAST(2) /= 3 THEN
251 FAILED
("WRONG BOUNDS PASSED - (E)");
254 X
:= (3..1 => (1..3 => ' '));
258 FAILED
("EXCEPTION RAISED IN TASK - (E)");
264 IF AR
'LAST /= 2 AND AR
'LAST(2) /= 3 THEN
265 FAILED
("BOUNDS CHANGED - (E)");
269 WHEN CONSTRAINT_ERROR
=>
271 FAILED
("EXCEPTION RAISED BEFORE CALL - (E)");
273 FAILED
("EXCEPTION RAISED ON RETURN - (E)");
276 FAILED
("EXCEPTION RAISED - (E)");
279 ---------------------------------------------