|
111
|
1 -- C85005C.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 -- OBJECTIVE:
|
|
|
26 -- CHECK THAT A VARIABLE CREATED BY AN ENTRY 'IN OUT' FORMAL
|
|
|
27 -- PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
|
|
|
28 -- THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
|
|
|
29 -- ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
|
|
|
30 -- AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
|
|
|
31 -- VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
|
|
|
32 -- REFLECTED BY THE VALUE OF THE NEW NAME.
|
|
|
33
|
|
|
34 -- HISTORY:
|
|
|
35 -- JET 03/15/88 CREATED ORIGINAL TEST.
|
|
|
36
|
|
|
37 WITH REPORT; USE REPORT;
|
|
|
38 PROCEDURE C85005C IS
|
|
|
39
|
|
|
40 TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
|
|
|
41 TYPE RECORD1 (D : INTEGER) IS
|
|
|
42 RECORD
|
|
|
43 FIELD1 : INTEGER := 1;
|
|
|
44 END RECORD;
|
|
|
45 TYPE POINTER1 IS ACCESS INTEGER;
|
|
|
46
|
|
|
47 PACKAGE PACK1 IS
|
|
|
48 TYPE PRIVY IS PRIVATE;
|
|
|
49 ZERO : CONSTANT PRIVY;
|
|
|
50 ONE : CONSTANT PRIVY;
|
|
|
51 TWO : CONSTANT PRIVY;
|
|
|
52 THREE : CONSTANT PRIVY;
|
|
|
53 FOUR : CONSTANT PRIVY;
|
|
|
54 FIVE : CONSTANT PRIVY;
|
|
|
55 FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
|
|
|
56 FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
|
|
|
57 PRIVATE
|
|
|
58 TYPE PRIVY IS RANGE 0..127;
|
|
|
59 ZERO : CONSTANT PRIVY := 0;
|
|
|
60 ONE : CONSTANT PRIVY := 1;
|
|
|
61 TWO : CONSTANT PRIVY := 2;
|
|
|
62 THREE : CONSTANT PRIVY := 3;
|
|
|
63 FOUR : CONSTANT PRIVY := 4;
|
|
|
64 FIVE : CONSTANT PRIVY := 5;
|
|
|
65 END PACK1;
|
|
|
66
|
|
|
67 TASK TYPE TASK1 IS
|
|
|
68 ENTRY ASSIGN (J : IN INTEGER);
|
|
|
69 ENTRY VALU (J : OUT INTEGER);
|
|
|
70 ENTRY NEXT;
|
|
|
71 ENTRY STOP;
|
|
|
72 END TASK1;
|
|
|
73
|
|
|
74 DI1 : INTEGER := 0;
|
|
|
75 DA1 : ARRAY1(1..3) := (OTHERS => 0);
|
|
|
76 DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
|
|
|
77 DP1 : POINTER1 := NEW INTEGER'(0);
|
|
|
78 DV1 : PACK1.PRIVY := PACK1.ZERO;
|
|
|
79 DT1 : TASK1;
|
|
|
80
|
|
|
81 I : INTEGER;
|
|
|
82
|
|
|
83 GENERIC
|
|
|
84 GI1 : IN OUT INTEGER;
|
|
|
85 GA1 : IN OUT ARRAY1;
|
|
|
86 GR1 : IN OUT RECORD1;
|
|
|
87 GP1 : IN OUT POINTER1;
|
|
|
88 GV1 : IN OUT PACK1.PRIVY;
|
|
|
89 GT1 : IN OUT TASK1;
|
|
|
90 PACKAGE GENERIC1 IS
|
|
|
91 END GENERIC1;
|
|
|
92
|
|
|
93 FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
|
|
|
94 BEGIN
|
|
|
95 IF EQUAL (3,3) THEN
|
|
|
96 RETURN P;
|
|
|
97 ELSE
|
|
|
98 RETURN NULL;
|
|
|
99 END IF;
|
|
|
100 END IDENT;
|
|
|
101
|
|
|
102 PACKAGE BODY PACK1 IS
|
|
|
103 FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
|
|
|
104 BEGIN
|
|
|
105 IF EQUAL(3,3) THEN
|
|
|
106 RETURN I;
|
|
|
107 ELSE
|
|
|
108 RETURN PRIVY'(0);
|
|
|
109 END IF;
|
|
|
110 END IDENT;
|
|
|
111
|
|
|
112 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
|
|
|
113 BEGIN
|
|
|
114 RETURN I+1;
|
|
|
115 END NEXT;
|
|
|
116 END PACK1;
|
|
|
117
|
|
|
118 PACKAGE BODY GENERIC1 IS
|
|
|
119 BEGIN
|
|
|
120 GI1 := GI1 + 1;
|
|
|
121 GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
|
|
|
122 GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
|
|
|
123 GP1 := NEW INTEGER'(GP1.ALL + 1);
|
|
|
124 GV1 := PACK1.NEXT(GV1);
|
|
|
125 GT1.NEXT;
|
|
|
126 END GENERIC1;
|
|
|
127
|
|
|
128 TASK BODY TASK1 IS
|
|
|
129 TASK_VALUE : INTEGER := 0;
|
|
|
130 ACCEPTING_ENTRIES : BOOLEAN := TRUE;
|
|
|
131 BEGIN
|
|
|
132 WHILE ACCEPTING_ENTRIES LOOP
|
|
|
133 SELECT
|
|
|
134 ACCEPT ASSIGN (J : IN INTEGER) DO
|
|
|
135 TASK_VALUE := J;
|
|
|
136 END ASSIGN;
|
|
|
137 OR
|
|
|
138 ACCEPT VALU (J : OUT INTEGER) DO
|
|
|
139 J := TASK_VALUE;
|
|
|
140 END VALU;
|
|
|
141 OR
|
|
|
142 ACCEPT NEXT DO
|
|
|
143 TASK_VALUE := TASK_VALUE + 1;
|
|
|
144 END NEXT;
|
|
|
145 OR
|
|
|
146 ACCEPT STOP DO
|
|
|
147 ACCEPTING_ENTRIES := FALSE;
|
|
|
148 END STOP;
|
|
|
149 END SELECT;
|
|
|
150 END LOOP;
|
|
|
151 END TASK1;
|
|
|
152
|
|
|
153 BEGIN
|
|
|
154 TEST ("C85005C", "CHECK THAT A VARIABLE CREATED BY AN ENTRY " &
|
|
|
155 "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
|
|
|
156 "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
|
|
|
157 "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
|
|
|
158 "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
|
|
|
159 "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
|
|
|
160 "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
|
|
|
161 "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
|
|
|
162 "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
|
|
|
163 "VALUE OF THE NEW NAME");
|
|
|
164
|
|
|
165 DECLARE
|
|
|
166 TASK MAIN_TASK IS
|
|
|
167 ENTRY START (TI1 : IN OUT INTEGER; TA1 : IN OUT ARRAY1;
|
|
|
168 TR1 : IN OUT RECORD1; TP1 : IN OUT POINTER1;
|
|
|
169 TV1 : IN OUT PACK1.PRIVY;
|
|
|
170 TT1 : IN OUT TASK1);
|
|
|
171 END MAIN_TASK;
|
|
|
172
|
|
|
173 TASK BODY MAIN_TASK IS
|
|
|
174 BEGIN
|
|
|
175 ACCEPT START (TI1: IN OUT INTEGER; TA1: IN OUT ARRAY1;
|
|
|
176 TR1: IN OUT RECORD1; TP1: IN OUT POINTER1;
|
|
|
177 TV1: IN OUT PACK1.PRIVY;
|
|
|
178 TT1: IN OUT TASK1) DO
|
|
|
179 DECLARE
|
|
|
180 XTI1 : INTEGER RENAMES TI1;
|
|
|
181 XTA1 : ARRAY1 RENAMES TA1;
|
|
|
182 XTR1 : RECORD1 RENAMES TR1;
|
|
|
183 XTP1 : POINTER1 RENAMES TP1;
|
|
|
184 XTV1 : PACK1.PRIVY RENAMES TV1;
|
|
|
185 XTT1 : TASK1 RENAMES TT1;
|
|
|
186
|
|
|
187 TASK TYPE TASK2 IS
|
|
|
188 ENTRY ENTRY1 (TTI1 : OUT INTEGER;
|
|
|
189 TTA1 : OUT ARRAY1;
|
|
|
190 TTR1 : OUT RECORD1;
|
|
|
191 TTP1 : IN OUT POINTER1;
|
|
|
192 TTV1 : IN OUT PACK1.PRIVY;
|
|
|
193 TTT1 : IN OUT TASK1);
|
|
|
194 END TASK2;
|
|
|
195
|
|
|
196 CHK_TASK : TASK2;
|
|
|
197
|
|
|
198 PROCEDURE PROC1 (PTI1 : IN OUT INTEGER;
|
|
|
199 PTA1 : IN OUT ARRAY1;
|
|
|
200 PTR1 : IN OUT RECORD1;
|
|
|
201 PTP1 : OUT POINTER1;
|
|
|
202 PTV1 : OUT PACK1.PRIVY;
|
|
|
203 PTT1 : IN OUT TASK1) IS
|
|
|
204 BEGIN
|
|
|
205 PTI1 := PTI1 + 1;
|
|
|
206 PTA1 := (PTA1(1)+1, PTA1(2)+1, PTA1(3)+1);
|
|
|
207 PTR1 := (D => 1,
|
|
|
208 FIELD1 => PTR1.FIELD1 + 1);
|
|
|
209 PTP1 := NEW INTEGER'(TP1.ALL + 1);
|
|
|
210 PTV1 := PACK1.NEXT(TV1);
|
|
|
211 PTT1.NEXT;
|
|
|
212 END PROC1;
|
|
|
213
|
|
|
214 TASK BODY TASK2 IS
|
|
|
215 BEGIN
|
|
|
216 ACCEPT ENTRY1 (TTI1 : OUT INTEGER;
|
|
|
217 TTA1 : OUT ARRAY1;
|
|
|
218 TTR1 : OUT RECORD1;
|
|
|
219 TTP1 : IN OUT POINTER1;
|
|
|
220 TTV1 : IN OUT PACK1.PRIVY;
|
|
|
221 TTT1 : IN OUT TASK1)
|
|
|
222 DO
|
|
|
223 TTI1 := TI1 + 1;
|
|
|
224 TTA1 := (TA1(1)+1,
|
|
|
225 TA1(2)+1, TA1(3)+1);
|
|
|
226 TTR1 := (D => 1,
|
|
|
227 FIELD1 => TR1.FIELD1 + 1);
|
|
|
228 TTP1 := NEW INTEGER'(TTP1.ALL + 1);
|
|
|
229 TTV1 := PACK1.NEXT(TTV1);
|
|
|
230 TTT1.NEXT;
|
|
|
231 END ENTRY1;
|
|
|
232 END TASK2;
|
|
|
233
|
|
|
234 PACKAGE GENPACK1 IS NEW GENERIC1
|
|
|
235 (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
|
|
|
236 BEGIN
|
|
|
237 IF XTI1 /= IDENT_INT(1) THEN
|
|
|
238 FAILED ("INCORRECT VALUE OF XTI1 (1)");
|
|
|
239 END IF;
|
|
|
240
|
|
|
241 IF XTA1 /= (IDENT_INT(1),IDENT_INT(1),
|
|
|
242 IDENT_INT(1)) THEN
|
|
|
243 FAILED ("INCORRECT VALUE OF XTA1 (1)");
|
|
|
244 END IF;
|
|
|
245
|
|
|
246 IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(1))
|
|
|
247 THEN
|
|
|
248 FAILED ("INCORRECT VALUE OF XTR1 (1)");
|
|
|
249 END IF;
|
|
|
250
|
|
|
251 IF XTP1 /= IDENT(TP1) OR
|
|
|
252 XTP1.ALL /= IDENT_INT(1) THEN
|
|
|
253 FAILED ("INCORRECT VALUE OF XTP1 (1)");
|
|
|
254 END IF;
|
|
|
255
|
|
|
256 IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.ONE))
|
|
|
257 THEN
|
|
|
258 FAILED ("INCORRECT VALUE OF XTV1 (1)");
|
|
|
259 END IF;
|
|
|
260
|
|
|
261 XTT1.VALU(I);
|
|
|
262 IF I /= IDENT_INT(1) THEN
|
|
|
263 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
264 "XTT1.VALU (1)");
|
|
|
265 END IF;
|
|
|
266
|
|
|
267 PROC1(XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
|
|
|
268
|
|
|
269 IF XTI1 /= IDENT_INT(2) THEN
|
|
|
270 FAILED ("INCORRECT VALUE OF XTI1 (2)");
|
|
|
271 END IF;
|
|
|
272
|
|
|
273 IF XTA1 /= (IDENT_INT(2),IDENT_INT(2),
|
|
|
274 IDENT_INT(2)) THEN
|
|
|
275 FAILED ("INCORRECT VALUE OF XTA1 (2)");
|
|
|
276 END IF;
|
|
|
277
|
|
|
278 IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(2))
|
|
|
279 THEN
|
|
|
280 FAILED ("INCORRECT VALUE OF XTR1 (2)");
|
|
|
281 END IF;
|
|
|
282
|
|
|
283 IF XTP1 /= IDENT(TP1) OR
|
|
|
284 XTP1.ALL /= IDENT_INT(2) THEN
|
|
|
285 FAILED ("INCORRECT VALUE OF XTP1 (2)");
|
|
|
286 END IF;
|
|
|
287
|
|
|
288 IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.TWO))
|
|
|
289 THEN
|
|
|
290 FAILED ("INCORRECT VALUE OF XTV1 (2)");
|
|
|
291 END IF;
|
|
|
292
|
|
|
293 XTT1.VALU(I);
|
|
|
294 IF I /= IDENT_INT(2) THEN
|
|
|
295 FAILED ("INCORRECT RETURN VALUE FROM " &
|
|
|
296 "XTT1.VALU (2)");
|
|
|
297 END IF;
|
|
|
298
|
|
|
299 CHK_TASK.ENTRY1
|
|
|
300 (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
|
|
|
301
|
|
|
302 IF XTI1 /= IDENT_INT(3) THEN
|
|
|
303 FAILED ("INCORRECT VALUE OF XTI1 (3)");
|
|
|
304 END IF;
|
|
|
305
|
|
|
306 IF XTA1 /= (IDENT_INT(3),IDENT_INT(3),
|
|
|
307 IDENT_INT(3)) THEN
|
|
|
308 FAILED ("INCORRECT VALUE OF XTA1 (3)");
|
|
|
309 END IF;
|
|
|
310
|
|
|
311 IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(3))
|
|
|
312 THEN
|
|
|
313 FAILED ("INCORRECT VALUE OF XTR1 (3)");
|
|
|
314 END IF;
|
|
|
315
|
|
|
316 IF XTP1 /= IDENT(TP1) OR
|
|
|
317 XTP1.ALL /= IDENT_INT(3) THEN
|
|
|
318 FAILED ("INCORRECT VALUE OF XTP1 (3)");
|
|
|
319 END IF;
|
|
|
320
|
|
|
321 IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.THREE))
|
|
|
322 THEN
|
|
|
323 FAILED ("INCORRECT VALUE OF XTV1 (3)");
|
|
|
324 END IF;
|
|
|
325
|
|
|
326 XTT1.VALU(I);
|
|
|
327 IF I /= IDENT_INT(3) THEN
|
|
|
328 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
329 "XTT1.VALU (3)");
|
|
|
330 END IF;
|
|
|
331
|
|
|
332 XTI1 := XTI1 + 1;
|
|
|
333 XTA1 := (XTA1(1)+1, XTA1(2)+1, XTA1(3)+1);
|
|
|
334 XTR1 := (D => 1, FIELD1 => XTR1.FIELD1 + 1);
|
|
|
335 XTP1 := NEW INTEGER'(XTP1.ALL + 1);
|
|
|
336 XTV1 := PACK1.NEXT(XTV1);
|
|
|
337 XTT1.NEXT;
|
|
|
338
|
|
|
339 IF XTI1 /= IDENT_INT(4) THEN
|
|
|
340 FAILED ("INCORRECT VALUE OF XTI1 (4)");
|
|
|
341 END IF;
|
|
|
342
|
|
|
343 IF XTA1 /= (IDENT_INT(4),IDENT_INT(4),
|
|
|
344 IDENT_INT(4)) THEN
|
|
|
345 FAILED ("INCORRECT VALUE OF XTA1 (4)");
|
|
|
346 END IF;
|
|
|
347
|
|
|
348 IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(4))
|
|
|
349 THEN
|
|
|
350 FAILED ("INCORRECT VALUE OF XTR1 (4)");
|
|
|
351 END IF;
|
|
|
352
|
|
|
353 IF XTP1 /= IDENT(TP1) OR
|
|
|
354 XTP1.ALL /= IDENT_INT(4) THEN
|
|
|
355 FAILED ("INCORRECT VALUE OF XTP1 (4)");
|
|
|
356 END IF;
|
|
|
357
|
|
|
358 IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FOUR))
|
|
|
359 THEN
|
|
|
360 FAILED ("INCORRECT VALUE OF XTV1 (4)");
|
|
|
361 END IF;
|
|
|
362
|
|
|
363 XTT1.VALU(I);
|
|
|
364 IF I /= IDENT_INT(4) THEN
|
|
|
365 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
366 "XTT1.VALU (4)");
|
|
|
367 END IF;
|
|
|
368
|
|
|
369 TI1 := TI1 + 1;
|
|
|
370 TA1 := (TA1(1)+1, TA1(2)+1, TA1(3)+1);
|
|
|
371 TR1 := (D => 1, FIELD1 => TR1.FIELD1 + 1);
|
|
|
372 TP1 := NEW INTEGER'(TP1.ALL + 1);
|
|
|
373 TV1 := PACK1.NEXT(TV1);
|
|
|
374 TT1.NEXT;
|
|
|
375
|
|
|
376 IF XTI1 /= IDENT_INT(5) THEN
|
|
|
377 FAILED ("INCORRECT VALUE OF XTI1 (5)");
|
|
|
378 END IF;
|
|
|
379
|
|
|
380 IF XTA1 /= (IDENT_INT(5),IDENT_INT(5),
|
|
|
381 IDENT_INT(5)) THEN
|
|
|
382 FAILED ("INCORRECT VALUE OF XTA1 (5)");
|
|
|
383 END IF;
|
|
|
384
|
|
|
385 IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(5))
|
|
|
386 THEN
|
|
|
387 FAILED ("INCORRECT VALUE OF XTR1 (5)");
|
|
|
388 END IF;
|
|
|
389
|
|
|
390 IF XTP1 /= IDENT(TP1) OR
|
|
|
391 XTP1.ALL /= IDENT_INT(5) THEN
|
|
|
392 FAILED ("INCORRECT VALUE OF XTP1 (5)");
|
|
|
393 END IF;
|
|
|
394
|
|
|
395 IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FIVE))
|
|
|
396 THEN
|
|
|
397 FAILED ("INCORRECT VALUE OF XTV1 (5)");
|
|
|
398 END IF;
|
|
|
399
|
|
|
400 XTT1.VALU(I);
|
|
|
401 IF I /= IDENT_INT(5) THEN
|
|
|
402 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
403 "XTT1.VALU (5)");
|
|
|
404 END IF;
|
|
|
405 END;
|
|
|
406 END START;
|
|
|
407 END MAIN_TASK;
|
|
|
408
|
|
|
409 BEGIN
|
|
|
410 MAIN_TASK.START (DI1, DA1, DR1, DP1, DV1, DT1);
|
|
|
411 END;
|
|
|
412
|
|
|
413 DT1.STOP;
|
|
|
414
|
|
|
415 RESULT;
|
|
|
416 END C85005C;
|
