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 A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
26 -- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
30 WITH REPORT
; USE REPORT
;
35 TYPE ITYPE
IS LIMITED PRIVATE;
39 ENTRY LOOK_IN_I
(X
: IN ITYPE
; V
: INTEGER; M
: STRING);
41 ENTRY LOOK_INOUT_I
(X
: IN OUT ITYPE
; V
: INTEGER;
44 ENTRY SET_I
(X
: IN OUT ITYPE
; V
: INTEGER);
48 SUBTYPE INT_0_20
IS INTEGER RANGE 0 .. 20;
49 TYPE VRTYPE
(C
: INT_0_20
:= 20) IS LIMITED PRIVATE;
53 ENTRY LOOK_IN_VR
(X
: IN VRTYPE
; C
: INTEGER;
54 I
: INTEGER; S
: STRING; M
: STRING);
56 ENTRY LOOK_INOUT_VR
(X
: IN OUT VRTYPE
; C
: INTEGER;
57 I
: INTEGER; S
: STRING;
60 ENTRY SET_VR
(X
: IN OUT VRTYPE
; C
: INTEGER;
61 I
: INTEGER; S
: STRING);
67 TYPE ITYPE
IS NEW INTEGER RANGE 0 .. 99;
69 TYPE VRTYPE
(C
: INT_0_20
:= 20) IS
81 TYPE ATYPE
IS ARRAY (1 .. 3) OF ITYPE
;
87 D
: CONSTANT INT_0_20
:= 10;
103 ACCEPT LOOK_IN_I
(X
: IN ITYPE
; V
: INTEGER;
105 IF INTEGER (X
) /= V
THEN
106 FAILED
("WRONG SCALAR VALUE - " & M
);
110 ACCEPT LOOK_INOUT_I
(X
: IN OUT ITYPE
;
113 IF INTEGER (X
) /= V
THEN
114 FAILED
("WRONG SCALAR VALUE - " & M
);
118 ACCEPT SET_I
(X
: IN OUT ITYPE
; V
: INTEGER) DO
119 X
:= ITYPE
(IDENT_INT
(V
));
131 ACCEPT LOOK_IN_VR
(X
: IN VRTYPE
; C
: INTEGER;
132 I
: INTEGER; S
: STRING;
134 IF (X
.C
/= C
OR X
.I
/= I
) OR ELSE
136 FAILED
("WRONG COMPOSITE VALUE - " &
141 ACCEPT LOOK_INOUT_VR
(X
: IN OUT VRTYPE
;
142 C
: INTEGER; I
: INTEGER;
145 IF (X
.C
/= C
OR X
.I
/= I
) OR ELSE
147 FAILED
("WRONG COMPOSITE VALUE - " &
152 ACCEPT SET_VR
(X
: IN OUT VRTYPE
; C
: INTEGER;
153 I
: INTEGER; S
: STRING) DO
154 X
:= (IDENT_INT
(C
), IDENT_INT
(I
),
164 I1
:= ITYPE
(IDENT_INT
(2));
166 FOR I
IN A1
'RANGE LOOP
167 A1
(I
) := ITYPE
(3 + IDENT_INT
(I
));
170 VR1
:= (IDENT_INT
(5), IDENT_INT
(4), IDENT_STR
("01234"));
172 R1
.J
:= ITYPE
(IDENT_INT
(6));
173 R1
.R
:= (IDENT_INT
(D
), IDENT_INT
(19),
174 IDENT_STR
("ABCDEFGHIJ"));
178 ENTRY CHECK_IN_I
(X
: IN ITYPE
; V
: INTEGER; M
: STRING);
180 ENTRY CHECK_INOUT_I
(X
: IN OUT ITYPE
; OV
: INTEGER;
181 NV
: INTEGER; M
: STRING);
183 ENTRY CHECK_IN_A
(X
: IN ATYPE
; V
: INTEGER; M
: STRING);
185 ENTRY CHECK_INOUT_A
(X
: IN OUT ATYPE
; OV
: INTEGER;
186 NV
: INTEGER; M
: STRING);
188 ENTRY CHECK_IN_VR
(X
: IN VRTYPE
; C
: INTEGER; I
: INTEGER;
189 S
: STRING; M
: STRING);
191 ENTRY CHECK_INOUT_VR
(X
: IN OUT VRTYPE
;
192 OC
: INTEGER; OI
: INTEGER; OS
: STRING;
193 NC
: INTEGER; NI
: INTEGER; NS
: STRING;
196 ENTRY CHECK_IN_R
(X
: IN RTYPE
; J
: INTEGER; C
: INTEGER;
197 I
: INTEGER; S
: STRING; M
: STRING);
199 ENTRY CHECK_INOUT_R
(X
: IN OUT RTYPE
; OJ
: INTEGER;
200 OC
: INTEGER; OI
: INTEGER; OS
: STRING;
202 NC
: INTEGER; NI
: INTEGER; NS
: STRING;
208 ACCEPT CHECK_IN_I
(X
: IN ITYPE
; V
: INTEGER; M
: STRING) DO
209 T1
.LOOK_IN_I
(X
, V
, M
);
212 ACCEPT CHECK_INOUT_I
(X
: IN OUT ITYPE
; OV
: INTEGER;
213 NV
: INTEGER; M
: STRING) DO
214 T1
.LOOK_INOUT_I
(X
, OV
, M
& " - A");
216 T1
.LOOK_INOUT_I
(X
, NV
, M
& " - B");
217 T1
.LOOK_IN_I
(X
, NV
, M
& " - C");
220 ACCEPT CHECK_IN_A
(X
: IN ATYPE
; V
: INTEGER; M
: STRING) DO
221 FOR I
IN X
'RANGE LOOP
222 T1
.LOOK_IN_I
(X
(I
), V
+I
, M
& " -" &
227 ACCEPT CHECK_INOUT_A
(X
: IN OUT ATYPE
; OV
: INTEGER;
228 NV
: INTEGER; M
: STRING) DO
229 FOR I
IN X
'RANGE LOOP
230 T1
.LOOK_INOUT_I
(X
(I
), OV
+I
, M
& " - A" &
232 T1
.SET_I
(X
(I
), NV
+I
);
233 T1
.LOOK_INOUT_I
(X
(I
), NV
+I
, M
& " - B" &
235 T1
.LOOK_IN_I
(X
(I
), NV
+I
, M
& " - C" &
240 ACCEPT CHECK_IN_VR
(X
: IN VRTYPE
; C
: INTEGER; I
: INTEGER;
241 S
: STRING; M
: STRING) DO
242 T2
.LOOK_IN_VR
(X
, C
, I
, S
, M
);
245 ACCEPT CHECK_INOUT_VR
(X
: IN OUT VRTYPE
;
246 OC
: INTEGER; OI
: INTEGER;
248 NC
: INTEGER; NI
: INTEGER;
251 T2
.LOOK_INOUT_VR
(X
, OC
, OI
, OS
, M
& " - A");
252 T2
.SET_VR
(X
, NC
, NI
, NS
);
253 T2
.LOOK_INOUT_VR
(X
, NC
, NI
, NS
, M
& " - B");
254 T2
.LOOK_IN_VR
(X
, NC
, NI
, NS
, M
& " - C");
257 ACCEPT CHECK_IN_R
(X
: IN RTYPE
; J
: INTEGER; C
: INTEGER;
258 I
: INTEGER; S
: STRING; M
: STRING) DO
259 T1
.LOOK_IN_I
(X
.J
, J
, M
& " - A");
260 T2
.LOOK_IN_VR
(X
.R
, C
, I
, S
, M
& " - B");
263 ACCEPT CHECK_INOUT_R
(X
: IN OUT RTYPE
; OJ
: INTEGER;
264 OC
: INTEGER; OI
: INTEGER; OS
: STRING;
266 NC
: INTEGER; NI
: INTEGER; NS
: STRING;
268 T1
.LOOK_INOUT_I
(X
.J
, OJ
, M
& " - A");
269 T2
.LOOK_INOUT_VR
(X
.R
, OC
, OI
, OS
, M
& " - B");
271 T2
.SET_VR
(X
.R
, NC
, NI
, NS
);
272 T1
.LOOK_INOUT_I
(X
.J
, NJ
, M
& " - C");
273 T2
.LOOK_INOUT_VR
(X
.R
, NC
, NI
, NS
, M
& " - D");
274 T1
.LOOK_IN_I
(X
.J
, NJ
, M
& " - E");
275 T2
.LOOK_IN_VR
(X
.R
, NC
, NI
, NS
, M
& " - F");
280 TEST
("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
281 "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
283 T3
.CHECK_IN_I
(I1
, 2, "IN I");
285 T3
.CHECK_INOUT_I
(I1
, 2, 5, "INOUT I");
287 T3
.CHECK_IN_A
(A1
, 3, "IN A");
289 T3
.CHECK_INOUT_A
(A1
, 3, 17, "INOUT A");
291 T3
.CHECK_IN_VR
(VR1
, 5, 4, "01234", "IN VR");
293 T3
.CHECK_INOUT_VR
(VR1
, 5, 4, "01234", 10, 11, "9876543210",
296 T3
.CHECK_IN_R
(R1
, 6, D
, 19, "ABCDEFGHIJ", "IN R");
298 T3
.CHECK_INOUT_R
(R1
, 6, D
, 19, "ABCDEFGHIJ", 13, D
, 5,
299 "ZYXWVUTSRQ", "INOUT R");