|
111
|
1 -- C95067A.ADA
|
|
|
2
|
|
|
3 -- Grant of Unlimited Rights
|
|
|
4 --
|
|
|
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
|
|
|
14 -- to do so.
|
|
|
15 --
|
|
|
16 -- DISCLAIMER
|
|
|
17 --
|
|
|
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.
|
|
|
24 --*
|
|
|
25 -- CHECK THAT A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
|
|
|
26 -- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
|
|
|
27
|
|
|
28 -- JWC 6/20/85
|
|
|
29
|
|
|
30 WITH REPORT; USE REPORT;
|
|
|
31 PROCEDURE C95067A IS
|
|
|
32
|
|
|
33 PACKAGE PKG IS
|
|
|
34
|
|
|
35 TYPE ITYPE IS LIMITED PRIVATE;
|
|
|
36
|
|
|
37 TASK T1 IS
|
|
|
38
|
|
|
39 ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
|
|
|
40
|
|
|
41 ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
|
|
|
42 M : STRING);
|
|
|
43
|
|
|
44 ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
|
|
|
45
|
|
|
46 END T1;
|
|
|
47
|
|
|
48 SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
|
|
|
49 TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
|
|
|
50
|
|
|
51 TASK T2 IS
|
|
|
52
|
|
|
53 ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
|
|
|
54 I : INTEGER; S : STRING; M : STRING);
|
|
|
55
|
|
|
56 ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
|
|
|
57 I : INTEGER; S : STRING;
|
|
|
58 M : STRING);
|
|
|
59
|
|
|
60 ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
|
|
|
61 I : INTEGER; S : STRING);
|
|
|
62
|
|
|
63 END T2;
|
|
|
64
|
|
|
65 PRIVATE
|
|
|
66
|
|
|
67 TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
|
|
|
68
|
|
|
69 TYPE VRTYPE (C : INT_0_20 := 20) IS
|
|
|
70 RECORD
|
|
|
71 I : INTEGER;
|
|
|
72 S : STRING (1 .. C);
|
|
|
73 END RECORD;
|
|
|
74
|
|
|
75 END PKG;
|
|
|
76
|
|
|
77 USE PKG;
|
|
|
78
|
|
|
79 I1 : ITYPE;
|
|
|
80
|
|
|
81 TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
|
|
|
82
|
|
|
83 A1 : ATYPE;
|
|
|
84
|
|
|
85 VR1 : VRTYPE;
|
|
|
86
|
|
|
87 D : CONSTANT INT_0_20 := 10;
|
|
|
88
|
|
|
89 TYPE RTYPE IS
|
|
|
90 RECORD
|
|
|
91 J : ITYPE;
|
|
|
92 R : VRTYPE (D);
|
|
|
93 END RECORD;
|
|
|
94
|
|
|
95 R1 : RTYPE;
|
|
|
96
|
|
|
97 PACKAGE BODY PKG IS
|
|
|
98
|
|
|
99 TASK BODY T1 IS
|
|
|
100 BEGIN
|
|
|
101 LOOP
|
|
|
102 SELECT
|
|
|
103 ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
|
|
|
104 M : STRING) DO
|
|
|
105 IF INTEGER (X) /= V THEN
|
|
|
106 FAILED ("WRONG SCALAR VALUE - " & M);
|
|
|
107 END IF;
|
|
|
108 END LOOK_IN_I;
|
|
|
109 OR
|
|
|
110 ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
|
|
|
111 V : INTEGER;
|
|
|
112 M : STRING) DO
|
|
|
113 IF INTEGER (X) /= V THEN
|
|
|
114 FAILED ("WRONG SCALAR VALUE - " & M);
|
|
|
115 END IF;
|
|
|
116 END LOOK_INOUT_I;
|
|
|
117 OR
|
|
|
118 ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
|
|
|
119 X := ITYPE (IDENT_INT (V));
|
|
|
120 END SET_I;
|
|
|
121 OR
|
|
|
122 TERMINATE;
|
|
|
123 END SELECT;
|
|
|
124 END LOOP;
|
|
|
125 END T1;
|
|
|
126
|
|
|
127 TASK BODY T2 IS
|
|
|
128 BEGIN
|
|
|
129 LOOP
|
|
|
130 SELECT
|
|
|
131 ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
|
|
|
132 I : INTEGER; S : STRING;
|
|
|
133 M : STRING) DO
|
|
|
134 IF (X.C /= C OR X.I /= I) OR ELSE
|
|
|
135 X.S /= S THEN
|
|
|
136 FAILED ("WRONG COMPOSITE VALUE - " &
|
|
|
137 M);
|
|
|
138 END IF;
|
|
|
139 END LOOK_IN_VR;
|
|
|
140 OR
|
|
|
141 ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
|
|
|
142 C : INTEGER; I : INTEGER;
|
|
|
143 S : STRING;
|
|
|
144 M : STRING) DO
|
|
|
145 IF (X.C /= C OR X.I /= I) OR ELSE
|
|
|
146 X.S /= S THEN
|
|
|
147 FAILED ("WRONG COMPOSITE VALUE - " &
|
|
|
148 M);
|
|
|
149 END IF;
|
|
|
150 END LOOK_INOUT_VR;
|
|
|
151 OR
|
|
|
152 ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
|
|
|
153 I : INTEGER; S : STRING) DO
|
|
|
154 X := (IDENT_INT(C), IDENT_INT(I),
|
|
|
155 IDENT_STR(S));
|
|
|
156 END SET_VR;
|
|
|
157 OR
|
|
|
158 TERMINATE;
|
|
|
159 END SELECT;
|
|
|
160 END LOOP;
|
|
|
161 END T2;
|
|
|
162
|
|
|
163 BEGIN
|
|
|
164 I1 := ITYPE (IDENT_INT(2));
|
|
|
165
|
|
|
166 FOR I IN A1'RANGE LOOP
|
|
|
167 A1 (I) := ITYPE (3 + IDENT_INT(I));
|
|
|
168 END LOOP;
|
|
|
169
|
|
|
170 VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
|
|
|
171
|
|
|
172 R1.J := ITYPE (IDENT_INT(6));
|
|
|
173 R1.R := (IDENT_INT(D), IDENT_INT(19),
|
|
|
174 IDENT_STR("ABCDEFGHIJ"));
|
|
|
175 END PKG;
|
|
|
176
|
|
|
177 TASK T3 IS
|
|
|
178 ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
|
|
|
179
|
|
|
180 ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
|
|
|
181 NV : INTEGER; M : STRING);
|
|
|
182
|
|
|
183 ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
|
|
|
184
|
|
|
185 ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
|
|
|
186 NV : INTEGER; M : STRING);
|
|
|
187
|
|
|
188 ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
|
|
189 S : STRING; M : STRING);
|
|
|
190
|
|
|
191 ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
|
|
|
192 OC : INTEGER; OI : INTEGER; OS : STRING;
|
|
|
193 NC : INTEGER; NI : INTEGER; NS : STRING;
|
|
|
194 M : STRING);
|
|
|
195
|
|
|
196 ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
|
|
|
197 I : INTEGER; S : STRING; M : STRING);
|
|
|
198
|
|
|
199 ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
|
|
|
200 OC : INTEGER; OI : INTEGER; OS : STRING;
|
|
|
201 NJ : INTEGER;
|
|
|
202 NC : INTEGER; NI : INTEGER; NS : STRING;
|
|
|
203 M : STRING);
|
|
|
204 END T3;
|
|
|
205
|
|
|
206 TASK BODY T3 IS
|
|
|
207 BEGIN
|
|
|
208 ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
|
|
|
209 T1.LOOK_IN_I (X, V, M);
|
|
|
210 END CHECK_IN_I;
|
|
|
211
|
|
|
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");
|
|
|
215 T1.SET_I (X, NV);
|
|
|
216 T1.LOOK_INOUT_I (X, NV, M & " - B");
|
|
|
217 T1.LOOK_IN_I (X, NV, M & " - C");
|
|
|
218 END CHECK_INOUT_I;
|
|
|
219
|
|
|
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 & " -" &
|
|
|
223 INTEGER'IMAGE (I));
|
|
|
224 END LOOP;
|
|
|
225 END CHECK_IN_A;
|
|
|
226
|
|
|
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" &
|
|
|
231 INTEGER'IMAGE (I));
|
|
|
232 T1.SET_I (X(I), NV+I);
|
|
|
233 T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
|
|
|
234 INTEGER'IMAGE (I));
|
|
|
235 T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
|
|
|
236 INTEGER'IMAGE (I));
|
|
|
237 END LOOP;
|
|
|
238 END CHECK_INOUT_A;
|
|
|
239
|
|
|
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);
|
|
|
243 END CHECK_IN_VR;
|
|
|
244
|
|
|
245 ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
|
|
|
246 OC : INTEGER; OI : INTEGER;
|
|
|
247 OS : STRING;
|
|
|
248 NC : INTEGER; NI : INTEGER;
|
|
|
249 NS : STRING;
|
|
|
250 M : STRING) DO
|
|
|
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");
|
|
|
255 END CHECK_INOUT_VR;
|
|
|
256
|
|
|
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");
|
|
|
261 END CHECK_IN_R;
|
|
|
262
|
|
|
263 ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
|
|
|
264 OC : INTEGER; OI : INTEGER; OS : STRING;
|
|
|
265 NJ : INTEGER;
|
|
|
266 NC : INTEGER; NI : INTEGER; NS : STRING;
|
|
|
267 M : STRING) DO
|
|
|
268 T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
|
|
|
269 T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
|
|
|
270 T1.SET_I (X.J, NJ);
|
|
|
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");
|
|
|
276 END CHECK_INOUT_R;
|
|
|
277 END T3;
|
|
|
278
|
|
|
279 BEGIN
|
|
|
280 TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
|
|
|
281 "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
|
|
|
282
|
|
|
283 T3.CHECK_IN_I (I1, 2, "IN I");
|
|
|
284
|
|
|
285 T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
|
|
|
286
|
|
|
287 T3.CHECK_IN_A (A1, 3, "IN A");
|
|
|
288
|
|
|
289 T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
|
|
|
290
|
|
|
291 T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
|
|
|
292
|
|
|
293 T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
|
|
|
294 "INOUT VR");
|
|
|
295
|
|
|
296 T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
|
|
|
297
|
|
|
298 T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
|
|
|
299 "ZYXWVUTSRQ", "INOUT R");
|
|
|
300
|
|
|
301 RESULT;
|
|
|
302 END C95067A;
|
