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 FOR ACCESS PARAMETERS
26 -- IN THE FOLLOWING CIRCUMSTANCES:
28 -- (2) AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL
29 -- ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS
30 -- DIFFERENT CONSTRAINTS.
33 -- (C) CASE 2, IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
34 -- (D) CASE 2, OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
35 -- (E) SAME AS (C), WITH TYPE CONVERSION.
36 -- (F) SAME AS (D), WITH TYPE CONVERSION.
48 TEST
("C64105C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
49 "AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL " &
50 "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
51 "DIFFERENT CONSTRAINTS" );
53 --------------------------------------------------
59 TYPE T
(D
: E
:= E1
) IS PRIVATE;
61 TYPE T
(D
: E
:= E1
) IS
77 ENTERED
: BOOLEAN := FALSE;
79 PROCEDURE P
(X
: IN OUT SA
) IS
85 FAILED
("EXCEPTION RAISED IN PROCEDURE - (C)");
93 WHEN CONSTRAINT_ERROR
=>
95 FAILED
("EXCEPTION RAISED BEFORE CALL - (C)");
97 FAILED
("EXCEPTION RAISED ON RETURN - (C)");
100 FAILED
("EXCEPTION RAISED - (C)");
103 --------------------------------------------------
107 TYPE T
IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
111 SUBTYPE SA
IS A
('D'..'F', FALSE..FALSE);
112 V
: A
(IDENT_CHAR
('A') .. IDENT_CHAR
('B'),
113 IDENT_BOOL
(TRUE) .. IDENT_BOOL
(TRUE)) := NULL;
114 ENTERED
: BOOLEAN := FALSE;
116 PROCEDURE P
(X
: OUT SA
) IS
122 FAILED
("EXCEPTION RAISED IN PROCEDURE - (D)");
130 WHEN CONSTRAINT_ERROR
=>
132 FAILED
("EXCEPTION RAISED BEFORE CALL - (D)");
134 FAILED
("EXCEPTION RAISED ON RETURN - (D)");
137 FAILED
("EXCEPTION RAISED - (D)");
140 --------------------------------------------------
146 TYPE T
(D
: E
:= E1
) IS PRIVATE;
148 TYPE T
(D
: E
:= E1
) IS
164 ENTERED
: BOOLEAN := FALSE;
166 PROCEDURE P
(X
: IN OUT SA
) IS
172 FAILED
("EXCEPTION RAISED IN PROCEDURE - (C)");
180 WHEN CONSTRAINT_ERROR
=>
182 FAILED
("EXCEPTION RAISED BEFORE CALL - (E)");
184 FAILED
("EXCEPTION RAISED ON RETURN - (E)");
187 FAILED
("EXCEPTION RAISED - (E)");
190 --------------------------------------------------
194 TYPE T
IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
198 SUBTYPE SA
IS A
('D'..'F', FALSE..FALSE);
199 V
: A
(IDENT_CHAR
('A') .. IDENT_CHAR
('B'),
200 IDENT_BOOL
(TRUE) .. IDENT_BOOL
(TRUE)) := NULL;
201 ENTERED
: BOOLEAN := FALSE;
203 PROCEDURE P
(X
: OUT SA
) IS
209 FAILED
("EXCEPTION RAISED IN PROCEDURE - (D)");
217 WHEN CONSTRAINT_ERROR
=>
219 FAILED
("EXCEPTION RAISED BEFORE CALL - (F)");
221 FAILED
("EXCEPTION RAISED ON RETURN - (F)");
224 FAILED
("EXCEPTION RAISED - (F)");
227 --------------------------------------------------