|
111
|
1 -- C95087A.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 UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
|
|
|
26 -- FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
|
|
|
27 -- SUBTESTS ARE:
|
|
|
28 -- (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
|
|
|
29 -- (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
|
|
|
30 -- (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
|
|
|
31 -- (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
|
|
|
32
|
|
|
33 -- GLH 7/19/85
|
|
|
34 -- JRK 8/23/85
|
|
|
35
|
|
|
36 WITH REPORT; USE REPORT;
|
|
|
37 PROCEDURE C95087A IS
|
|
|
38
|
|
|
39 BEGIN
|
|
|
40 TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
|
|
|
41 "UNCONSTRAINED FORMAL PARAMETERS");
|
|
|
42
|
|
|
43 DECLARE -- (A)
|
|
|
44
|
|
|
45 PACKAGE PKG IS
|
|
|
46
|
|
|
47 SUBTYPE INT IS INTEGER RANGE 0..100;
|
|
|
48
|
|
|
49 TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
|
|
50 RECORD
|
|
|
51 INTFIELD : INTEGER;
|
|
|
52 STRFIELD : STRING (1..CONSTRAINT);
|
|
|
53 END RECORD;
|
|
|
54
|
|
|
55 REC1 : RECTYPE := (10,10,"0123456789");
|
|
|
56 REC2 : RECTYPE := (17,7,"C95087A..........");
|
|
|
57 REC3 : RECTYPE := (1,1,"A");
|
|
|
58 REC4 : RECTYPE; -- 80.
|
|
|
59
|
|
|
60 TASK T1 IS
|
|
|
61 ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");
|
|
|
62 REC2 : OUT RECTYPE;
|
|
|
63 REC3 : IN OUT RECTYPE);
|
|
|
64 END T1;
|
|
|
65
|
|
|
66 TASK T2 IS
|
|
|
67 ENTRY E2 (REC : OUT RECTYPE);
|
|
|
68 END T2;
|
|
|
69 END PKG;
|
|
|
70
|
|
|
71 PACKAGE BODY PKG IS
|
|
|
72
|
|
|
73 TASK BODY T1 IS
|
|
|
74 BEGIN
|
|
|
75 ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");
|
|
|
76 REC2 : OUT RECTYPE;
|
|
|
77 REC3 : IN OUT RECTYPE) DO
|
|
|
78
|
|
|
79 IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
|
|
|
80 FAILED ("RECORD TYPE IN PARAMETER " &
|
|
|
81 "DID NOT USE CONSTRAINT " &
|
|
|
82 "OF ACTUAL");
|
|
|
83 END IF;
|
|
|
84 IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
|
|
|
85 FAILED ("RECORD TYPE OUT " &
|
|
|
86 "PARAMETER DID NOT USE " &
|
|
|
87 "CONSTRAINT OF ACTUAL");
|
|
|
88 END IF;
|
|
|
89 IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
|
|
|
90 FAILED ("RECORD TYPE IN OUT " &
|
|
|
91 "PARAMETER DID NOT USE " &
|
|
|
92 "CONSTRAINT OF ACTUAL");
|
|
|
93 END IF;
|
|
|
94 REC2 := PKG.REC2;
|
|
|
95 END E1;
|
|
|
96 END T1;
|
|
|
97
|
|
|
98 TASK BODY T2 IS
|
|
|
99 BEGIN
|
|
|
100 ACCEPT E2 (REC : OUT RECTYPE) DO
|
|
|
101 IF REC.CONSTRAINT /= IDENT_INT (80) THEN
|
|
|
102 FAILED ("RECORD TYPE OUT " &
|
|
|
103 "PARAMETER DID " &
|
|
|
104 "NOT USE CONSTRAINT OF " &
|
|
|
105 "UNINITIALIZED ACTUAL");
|
|
|
106 END IF;
|
|
|
107 REC := (10,10,"9876543210");
|
|
|
108 END E2;
|
|
|
109 END T2;
|
|
|
110 END PKG;
|
|
|
111
|
|
|
112 BEGIN -- (A)
|
|
|
113
|
|
|
114 PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);
|
|
|
115 PKG.T2.E2 (PKG.REC4);
|
|
|
116
|
|
|
117 END; -- (A)
|
|
|
118
|
|
|
119 ---------------------------------------------
|
|
|
120
|
|
|
121 B : DECLARE -- (B)
|
|
|
122
|
|
|
123 PACKAGE PKG IS
|
|
|
124
|
|
|
125 SUBTYPE INT IS INTEGER RANGE 0..100;
|
|
|
126
|
|
|
127 TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
|
|
|
128
|
|
|
129
|
|
|
130 TASK T1 IS
|
|
|
131 ENTRY E1 (REC1 : IN RECTYPE;
|
|
|
132 REC2 : OUT RECTYPE;
|
|
|
133 REC3 : IN OUT RECTYPE);
|
|
|
134 END T1;
|
|
|
135
|
|
|
136 TASK T2 IS
|
|
|
137 ENTRY E2 (REC : OUT RECTYPE);
|
|
|
138 END T2;
|
|
|
139
|
|
|
140 PRIVATE
|
|
|
141 TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
|
|
142 RECORD
|
|
|
143 INTFIELD : INTEGER;
|
|
|
144 STRFIELD : STRING (1..CONSTRAINT);
|
|
|
145 END RECORD;
|
|
|
146 END PKG;
|
|
|
147
|
|
|
148 REC1 : PKG.RECTYPE (10);
|
|
|
149 REC2 : PKG.RECTYPE (17);
|
|
|
150 REC3 : PKG.RECTYPE (1);
|
|
|
151 REC4 : PKG.RECTYPE (10);
|
|
|
152
|
|
|
153 PACKAGE BODY PKG IS
|
|
|
154
|
|
|
155 TASK BODY T1 IS
|
|
|
156 BEGIN
|
|
|
157 ACCEPT E1 (REC1 : IN RECTYPE;
|
|
|
158 REC2 : OUT RECTYPE;
|
|
|
159 REC3 : IN OUT RECTYPE) DO
|
|
|
160 IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
|
|
|
161 FAILED ("PRIVATE TYPE IN " &
|
|
|
162 "PARAMETER DID " &
|
|
|
163 "NOT USE CONSTRAINT OF " &
|
|
|
164 "ACTUAL");
|
|
|
165 END IF;
|
|
|
166 IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
|
|
|
167 FAILED ("PRIVATE TYPE OUT " &
|
|
|
168 "PARAMETER DID " &
|
|
|
169 "NOT USE CONSTRAINT OF " &
|
|
|
170 "ACTUAL");
|
|
|
171 END IF;
|
|
|
172 IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
|
|
|
173 FAILED ("PRIVATE TYPE IN OUT " &
|
|
|
174 "PARAMETER DID " &
|
|
|
175 "NOT USE CONSTRAINT OF " &
|
|
|
176 "ACTUAL");
|
|
|
177 END IF;
|
|
|
178 REC2 := B.REC2;
|
|
|
179 END E1;
|
|
|
180 END T1;
|
|
|
181
|
|
|
182 TASK BODY T2 IS
|
|
|
183 BEGIN
|
|
|
184 ACCEPT E2 (REC : OUT RECTYPE) DO
|
|
|
185 IF REC.CONSTRAINT /= IDENT_INT (10) THEN
|
|
|
186 FAILED ("PRIVATE TYPE OUT " &
|
|
|
187 "PARAMETER DID " &
|
|
|
188 "NOT USE CONSTRAINT OF " &
|
|
|
189 "UNINITIALIZED ACTUAL");
|
|
|
190 END IF;
|
|
|
191 REC := (10,10,"9876543210");
|
|
|
192 END E2;
|
|
|
193 END T2;
|
|
|
194
|
|
|
195 BEGIN
|
|
|
196 REC1 := (10,10,"0123456789");
|
|
|
197 REC2 := (17,7,"C95087A..........");
|
|
|
198 REC3 := (1,1,"A");
|
|
|
199 END PKG;
|
|
|
200
|
|
|
201 BEGIN -- (B)
|
|
|
202
|
|
|
203 PKG.T1.E1 (REC1, REC2, REC3);
|
|
|
204 PKG.T2.E2 (REC4);
|
|
|
205
|
|
|
206 END B; -- (B)
|
|
|
207
|
|
|
208 ---------------------------------------------
|
|
|
209
|
|
|
210 C : DECLARE -- (C)
|
|
|
211
|
|
|
212 PACKAGE PKG IS
|
|
|
213
|
|
|
214 SUBTYPE INT IS INTEGER RANGE 0..100;
|
|
|
215
|
|
|
216 TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
|
|
217 LIMITED PRIVATE;
|
|
|
218
|
|
|
219 TASK T1 IS
|
|
|
220 ENTRY E1 (REC1 : IN RECTYPE;
|
|
|
221 REC2 : OUT RECTYPE;
|
|
|
222 REC3 : IN OUT RECTYPE);
|
|
|
223 END T1;
|
|
|
224
|
|
|
225 TASK T2 IS
|
|
|
226 ENTRY E2 (REC : OUT RECTYPE);
|
|
|
227 END T2;
|
|
|
228
|
|
|
229 PRIVATE
|
|
|
230 TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
|
|
231 RECORD
|
|
|
232 INTFIELD : INTEGER;
|
|
|
233 STRFIELD : STRING (1..CONSTRAINT);
|
|
|
234 END RECORD;
|
|
|
235 END PKG;
|
|
|
236
|
|
|
237 REC1 : PKG.RECTYPE; -- 10.
|
|
|
238 REC2 : PKG.RECTYPE; -- 17.
|
|
|
239 REC3 : PKG.RECTYPE; -- 1.
|
|
|
240 REC4 : PKG.RECTYPE; -- 80.
|
|
|
241
|
|
|
242 PACKAGE BODY PKG IS
|
|
|
243
|
|
|
244 TASK BODY T1 IS
|
|
|
245 BEGIN
|
|
|
246 ACCEPT E1 (REC1 : IN RECTYPE;
|
|
|
247 REC2 : OUT RECTYPE;
|
|
|
248 REC3 : IN OUT RECTYPE) DO
|
|
|
249 IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
|
|
|
250 FAILED ("LIMITED PRIVATE TYPE IN " &
|
|
|
251 "PARAMETER DID NOT USE " &
|
|
|
252 "CONSTRAINT OF ACTUAL");
|
|
|
253 END IF;
|
|
|
254 IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
|
|
|
255 FAILED ("LIMITED PRIVATE TYPE OUT " &
|
|
|
256 "PARAMETER DID NOT USE " &
|
|
|
257 "CONSTRAINT OF " &
|
|
|
258 "ACTUAL");
|
|
|
259 END IF;
|
|
|
260 IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
|
|
|
261 FAILED ("LIMITED PRIVATE TYPE IN " &
|
|
|
262 "OUT PARAMETER DID NOT " &
|
|
|
263 "USE CONSTRAINT OF ACTUAL");
|
|
|
264 END IF;
|
|
|
265 REC2 := C.REC2;
|
|
|
266 END E1;
|
|
|
267 END T1;
|
|
|
268
|
|
|
269 TASK BODY T2 IS
|
|
|
270 BEGIN
|
|
|
271 ACCEPT E2 (REC : OUT RECTYPE) DO
|
|
|
272 IF REC.CONSTRAINT /= IDENT_INT (80) THEN
|
|
|
273 FAILED ("LIMITED PRIVATE TYPE OUT " &
|
|
|
274 "PARAMETER DID NOT USE " &
|
|
|
275 "CONSTRAINT OF UNINITIALIZED " &
|
|
|
276 "ACTUAL");
|
|
|
277 END IF;
|
|
|
278 REC := (10,10,"9876543210");
|
|
|
279 END E2;
|
|
|
280 END T2;
|
|
|
281
|
|
|
282 BEGIN
|
|
|
283 REC1 := (10,10,"0123456789");
|
|
|
284 REC2 := (17,7,"C95087A..........");
|
|
|
285 REC3 := (1,1,"A");
|
|
|
286 END PKG;
|
|
|
287
|
|
|
288 BEGIN -- (C)
|
|
|
289
|
|
|
290 PKG.T1.E1 (REC1, REC2, REC3);
|
|
|
291 PKG.T2.E2 (REC4);
|
|
|
292
|
|
|
293 END C; -- (C)
|
|
|
294
|
|
|
295 ---------------------------------------------
|
|
|
296
|
|
|
297 D : DECLARE -- (D)
|
|
|
298
|
|
|
299 TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
|
|
|
300 CHARACTER;
|
|
|
301
|
|
|
302 A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),
|
|
|
303 ('C','D'),
|
|
|
304 ('E','F'));
|
|
|
305
|
|
|
306 A4 : ATYPE (-1..1, 4..5);
|
|
|
307
|
|
|
308 CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=
|
|
|
309 (8..9 => (-7..INTEGER'FIRST => 'A'));
|
|
|
310
|
|
|
311 S1 : STRING (1..INTEGER'FIRST) := "";
|
|
|
312 S2 : STRING (-5..-7) := "";
|
|
|
313 S3 : STRING (1..0) := "";
|
|
|
314
|
|
|
315 TASK T1 IS
|
|
|
316 ENTRY E1 (A1 : IN ATYPE := CA1;
|
|
|
317 A2 : OUT ATYPE;
|
|
|
318 A3 : IN OUT ATYPE);
|
|
|
319 END T1;
|
|
|
320
|
|
|
321 TASK T2 IS
|
|
|
322 ENTRY E2 (A4 : OUT ATYPE);
|
|
|
323 END T2;
|
|
|
324
|
|
|
325 TASK T3 IS
|
|
|
326 ENTRY E3 (S1 : IN STRING;
|
|
|
327 S2 : IN OUT STRING;
|
|
|
328 S3 : OUT STRING);
|
|
|
329 END T3;
|
|
|
330
|
|
|
331 TASK BODY T1 IS
|
|
|
332 BEGIN
|
|
|
333 ACCEPT E1 (A1 : IN ATYPE := CA1; A2 : OUT ATYPE;
|
|
|
334 A3 : IN OUT ATYPE) DO
|
|
|
335 IF A1'FIRST(1) /= IDENT_INT (-1) OR
|
|
|
336 A1'LAST(1) /= IDENT_INT (1) OR
|
|
|
337 A1'FIRST(2) /= IDENT_INT (4) OR
|
|
|
338 A1'LAST(2) /= IDENT_INT (5) THEN
|
|
|
339 FAILED ("ARRAY TYPE IN PARAMETER DID " &
|
|
|
340 "NOT USE CONSTRAINTS OF ACTUAL");
|
|
|
341 END IF;
|
|
|
342 IF A2'FIRST(1) /= IDENT_INT (-1) OR
|
|
|
343 A2'LAST(1) /= IDENT_INT (1) OR
|
|
|
344 A2'FIRST(2) /= IDENT_INT (4) OR
|
|
|
345 A2'LAST(2) /= IDENT_INT (5) THEN
|
|
|
346 FAILED ("ARRAY TYPE OUT PARAMETER DID " &
|
|
|
347 "NOT USE CONSTRAINTS OF ACTUAL");
|
|
|
348 END IF;
|
|
|
349 IF A3'FIRST(1) /= IDENT_INT (-1) OR
|
|
|
350 A3'LAST(1) /= IDENT_INT (1) OR
|
|
|
351 A3'FIRST(2) /= IDENT_INT (4) OR
|
|
|
352 A3'LAST(2) /= IDENT_INT (5) THEN
|
|
|
353 FAILED ("ARRAY TYPE IN OUT PARAMETER " &
|
|
|
354 "DID NOT USE CONSTRAINTS OF " &
|
|
|
355 "ACTUAL");
|
|
|
356 END IF;
|
|
|
357 A2 := D.A2;
|
|
|
358 END E1;
|
|
|
359 END T1;
|
|
|
360
|
|
|
361 TASK BODY T2 IS
|
|
|
362 BEGIN
|
|
|
363 ACCEPT E2 (A4 : OUT ATYPE) DO
|
|
|
364 IF A4'FIRST(1) /= IDENT_INT (-1) OR
|
|
|
365 A4'LAST(1) /= IDENT_INT (1) OR
|
|
|
366 A4'FIRST(2) /= IDENT_INT (4) OR
|
|
|
367 A4'LAST(2) /= IDENT_INT (5) THEN
|
|
|
368 FAILED ("ARRAY TYPE OUT PARAMETER DID " &
|
|
|
369 "NOT USE CONSTRAINTS OF " &
|
|
|
370 "UNINITIALIZED ACTUAL");
|
|
|
371 END IF;
|
|
|
372 A4 := A2;
|
|
|
373 END E2;
|
|
|
374 END T2;
|
|
|
375
|
|
|
376 TASK BODY T3 IS
|
|
|
377 BEGIN
|
|
|
378 ACCEPT E3 (S1 : IN STRING;
|
|
|
379 S2 : IN OUT STRING;
|
|
|
380 S3 : OUT STRING) DO
|
|
|
381 IF S1'FIRST /= IDENT_INT (1) OR
|
|
|
382 S1'LAST /= IDENT_INT (INTEGER'FIRST) THEN
|
|
|
383 FAILED ("STRING TYPE IN PARAMETER DID " &
|
|
|
384 "NOT USE CONSTRAINTS OF ACTUAL " &
|
|
|
385 "NULL STRING");
|
|
|
386 END IF;
|
|
|
387 IF S2'FIRST /= IDENT_INT (-5) OR
|
|
|
388 S2'LAST /= IDENT_INT (-7) THEN
|
|
|
389 FAILED ("STRING TYPE IN OUT PARAMETER " &
|
|
|
390 "DID NOT USE CONSTRAINTS OF " &
|
|
|
391 "ACTUAL NULL STRING");
|
|
|
392 END IF;
|
|
|
393 IF S3'FIRST /= IDENT_INT (1) OR
|
|
|
394 S3'LAST /= IDENT_INT (0) THEN
|
|
|
395 FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
|
|
|
396 "USE CONSTRAINTS OF ACTUAL NULL " &
|
|
|
397 "STRING");
|
|
|
398 END IF;
|
|
|
399 S3 := "";
|
|
|
400 END E3;
|
|
|
401 END T3;
|
|
|
402
|
|
|
403 BEGIN -- (D)
|
|
|
404
|
|
|
405 T1.E1 (A1, A2, A3);
|
|
|
406 T2.E2 (A4);
|
|
|
407 T3.E3 (S1, S2, S3);
|
|
|
408
|
|
|
409 END D; -- (D)
|
|
|
410
|
|
|
411 RESULT;
|
|
|
412 END C95087A;
|
