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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR
26 -- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT
27 -- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL
28 -- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER
29 -- FOR THE OTHER MODES.
33 WITH REPORT
; USE REPORT
;
37 TEST
( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
38 "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
39 "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
40 "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &
41 "APPLIED TO FORMAL PARAMETERS OF MODE IN " &
42 "AND HAS THE VALUE OF THE ACTUAL PARAMETER " &
43 "FOR THE OTHER MODES" );
48 SUBTYPE INT
IS INTEGER RANGE 1 .. 5;
50 TYPE MATRIX
IS ARRAY (INT
RANGE <>, INT
RANGE <>)
53 TYPE SQUARE
(SIDE
: INT
:= 1) IS
55 MAT
: MATRIX
(1 .. SIDE
, 1 .. SIDE
);
58 SC
: CONSTANT SQUARE
:= (2, ((0, 0), (0, 0)));
60 AC
: SQUARE
(2) := (2, ((1, 2), (3, 4)));
61 AU
: SQUARE
:= (SIDE
=> 1, MAT
=> (1 => (1 => 1)));
63 BC
: SQUARE
(2) := AC
;
69 PROCEDURE P
(CON
, IN_CON
: IN SQUARE
;
70 INOUT_CON
: IN OUT SQUARE
;
73 INOUT_UNC
: IN OUT SQUARE
;
74 OUT_UNC
: OUT SQUARE
) IS
77 IF CON
'CONSTRAINED THEN
80 FAILED
( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
84 IF IN_CON
'CONSTRAINED THEN
87 FAILED
( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
91 IF IN_UNC
'CONSTRAINED THEN
94 FAILED
( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
98 IF INOUT_CON
'CONSTRAINED THEN
101 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
102 "CONSTRAINED OBJECT OF IN OUT MODE - 1" );
105 IF OUT_CON
'CONSTRAINED THEN
108 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
109 "CONSTRAINED OBJECT OF OUT MODE - 1" );
112 IF INOUT_UNC
'CONSTRAINED THEN
113 FAILED
( "'CONSTRAINED IS 'TRUE' FOR " &
114 "UNCONSTRAINED OBJECT OF IN OUT MODE " &
118 IF OUT_UNC
'CONSTRAINED THEN
119 FAILED
( "'CONSTRAINED IS 'TRUE' FOR " &
120 "UNCONSTRAINED OBJECT OF OUT MODE - 1" );
123 OUT_CON
:= (2, ((1, 2), (3, 4)));
124 OUT_UNC
:= (2, ((1, 2), (3, 4)));
128 ENTRY Q
(CON
, IN_CON
: IN SQUARE
;
129 INOUT_CON
: IN OUT SQUARE
;
130 OUT_CON
: OUT SQUARE
;
132 INOUT_UNC
: IN OUT SQUARE
;
133 OUT_UNC
: OUT SQUARE
);
138 ACCEPT Q
(CON
, IN_CON
: IN SQUARE
;
139 INOUT_CON
: IN OUT SQUARE
;
140 OUT_CON
: OUT SQUARE
;
142 INOUT_UNC
: IN OUT SQUARE
;
143 OUT_UNC
: OUT SQUARE
) DO
145 IF CON
'CONSTRAINED THEN
148 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
149 "OBJECT OF IN MODE - 4" );
152 IF IN_CON
'CONSTRAINED THEN
155 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
156 "OBJECT OF IN MODE - 5" );
159 IF IN_UNC
'CONSTRAINED THEN
162 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
163 "OBJECT OF IN MODE - 6" );
166 IF INOUT_CON
'CONSTRAINED THEN
169 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
170 "CONSTRAINED OBJECT OF " &
174 IF OUT_CON
'CONSTRAINED THEN
177 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
178 "CONSTRAINED OBJECT OF " &
182 IF INOUT_UNC
'CONSTRAINED THEN
183 FAILED
( "'CONSTRAINED IS 'TRUE' FOR " &
184 "UNCONSTRAINED OBJECT OF " &
188 IF OUT_UNC
'CONSTRAINED THEN
189 FAILED
( "'CONSTRAINED IS 'TRUE' FOR " &
190 "UNCONSTRAINED OBJECT OF " &
194 OUT_CON
:= (2, ((1, 2), (3, 4)));
195 OUT_UNC
:= (2, ((1, 2), (3, 4)));
201 CON
, IN_CON
: IN SQUARE
;
202 INOUT_CON
: IN OUT SQUARE
;
204 INOUT_UNC
: IN OUT SQUARE
;
209 IF CON
'CONSTRAINED THEN
212 FAILED
( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
216 IF IN_CON
'CONSTRAINED THEN
219 FAILED
( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
223 IF IN_UNC
'CONSTRAINED THEN
226 FAILED
( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
230 IF INOUT_CON
'CONSTRAINED THEN
233 FAILED
( "'CONSTRAINED IS 'FALSE' FOR " &
234 "CONSTRAINED OBJECT OF IN OUT MODE - 3" );
237 IF INOUT_UNC
'CONSTRAINED THEN
238 FAILED
( "'CONSTRAINED IS 'TRUE' FOR " &
239 "UNCONSTRAINED OBJECT OF IN OUT MODE " &
245 PACKAGE S
IS NEW R
(SC
, AC
, BC
, AU
, BU
);
248 P
(SC
, AC
, BC
, CC
, AU
, BU
, CU
);
249 T
.Q
(SC
, AC
, BC
, CC
, AU
, BU
, CU
);