|
111
|
1 -- C85005B.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 A SUBPROGRAM '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 C85005B 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 PROCEDURE PROC (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
|
|
|
154 PR1 : IN OUT RECORD1; PP1 : IN OUT POINTER1;
|
|
|
155 PV1 : IN OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
|
|
|
156 XPI1 : INTEGER RENAMES PI1;
|
|
|
157 XPA1 : ARRAY1 RENAMES PA1;
|
|
|
158 XPR1 : RECORD1 RENAMES PR1;
|
|
|
159 XPP1 : POINTER1 RENAMES PP1;
|
|
|
160 XPV1 : PACK1.PRIVY RENAMES PV1;
|
|
|
161 XPT1 : TASK1 RENAMES PT1;
|
|
|
162
|
|
|
163 TASK TYPE TASK2 IS
|
|
|
164 ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
|
|
|
165 TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
|
|
|
166 TV1 : IN OUT PACK1.PRIVY;
|
|
|
167 TT1 : IN OUT TASK1);
|
|
|
168 END TASK2;
|
|
|
169
|
|
|
170 CHK_TASK : TASK2;
|
|
|
171
|
|
|
172 PROCEDURE PROC1 (PPI1 : IN OUT INTEGER; PPA1 : IN OUT ARRAY1;
|
|
|
173 PPR1 : IN OUT RECORD1; PPP1 : OUT POINTER1;
|
|
|
174 PPV1 : OUT PACK1.PRIVY;
|
|
|
175 PPT1 : IN OUT TASK1) IS
|
|
|
176 BEGIN
|
|
|
177 PPI1 := PPI1 + 1;
|
|
|
178 PPA1 := (PPA1(1)+1, PPA1(2)+1, PPA1(3)+1);
|
|
|
179 PPR1 := (D => 1, FIELD1 => PPR1.FIELD1 + 1);
|
|
|
180 PPP1 := NEW INTEGER'(PP1.ALL + 1);
|
|
|
181 PPV1 := PACK1.NEXT(PV1);
|
|
|
182 PPT1.NEXT;
|
|
|
183 END PROC1;
|
|
|
184
|
|
|
185 TASK BODY TASK2 IS
|
|
|
186 BEGIN
|
|
|
187 ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
|
|
|
188 TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
|
|
|
189 TV1 : IN OUT PACK1.PRIVY;
|
|
|
190 TT1 : IN OUT TASK1)
|
|
|
191 DO
|
|
|
192 TI1 := PI1 + 1;
|
|
|
193 TA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
|
|
|
194 TR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
|
|
|
195 TP1 := NEW INTEGER'(TP1.ALL + 1);
|
|
|
196 TV1 := PACK1.NEXT(TV1);
|
|
|
197 TT1.NEXT;
|
|
|
198 END ENTRY1;
|
|
|
199 END TASK2;
|
|
|
200
|
|
|
201 PACKAGE GENPACK1 IS NEW GENERIC1
|
|
|
202 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
|
|
|
203
|
|
|
204 BEGIN
|
|
|
205 IF XPI1 /= IDENT_INT(1) THEN
|
|
|
206 FAILED ("INCORRECT VALUE OF XPI1 (1)");
|
|
|
207 END IF;
|
|
|
208
|
|
|
209 IF XPA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
|
|
|
210 FAILED ("INCORRECT VALUE OF XPA1 (1)");
|
|
|
211 END IF;
|
|
|
212
|
|
|
213 IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
|
|
|
214 FAILED ("INCORRECT VALUE OF XPR1 (1)");
|
|
|
215 END IF;
|
|
|
216
|
|
|
217 IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(1) THEN
|
|
|
218 FAILED ("INCORRECT VALUE OF XPP1 (1)");
|
|
|
219 END IF;
|
|
|
220
|
|
|
221 IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.ONE)) THEN
|
|
|
222 FAILED ("INCORRECT VALUE OF XPV1 (1)");
|
|
|
223 END IF;
|
|
|
224
|
|
|
225 XPT1.VALU(I);
|
|
|
226 IF I /= IDENT_INT(1) THEN
|
|
|
227 FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (1)");
|
|
|
228 END IF;
|
|
|
229
|
|
|
230 PROC1(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
|
|
|
231
|
|
|
232 IF XPI1 /= IDENT_INT(2) THEN
|
|
|
233 FAILED ("INCORRECT VALUE OF XPI1 (2)");
|
|
|
234 END IF;
|
|
|
235
|
|
|
236 IF XPA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
|
|
|
237 FAILED ("INCORRECT VALUE OF XPA1 (2)");
|
|
|
238 END IF;
|
|
|
239
|
|
|
240 IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
|
|
|
241 FAILED ("INCORRECT VALUE OF XPR1 (2)");
|
|
|
242 END IF;
|
|
|
243
|
|
|
244 IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(2) THEN
|
|
|
245 FAILED ("INCORRECT VALUE OF XPP1 (2)");
|
|
|
246 END IF;
|
|
|
247
|
|
|
248 IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.TWO)) THEN
|
|
|
249 FAILED ("INCORRECT VALUE OF XPV1 (2)");
|
|
|
250 END IF;
|
|
|
251
|
|
|
252 XPT1.VALU(I);
|
|
|
253 IF I /= IDENT_INT(2) THEN
|
|
|
254 FAILED ("INCORRECT RETURN VALUE FROM XPT1.VALU (2)");
|
|
|
255 END IF;
|
|
|
256
|
|
|
257 CHK_TASK.ENTRY1 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
|
|
|
258
|
|
|
259 IF XPI1 /= IDENT_INT(3) THEN
|
|
|
260 FAILED ("INCORRECT VALUE OF XPI1 (3)");
|
|
|
261 END IF;
|
|
|
262
|
|
|
263 IF XPA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
|
|
|
264 FAILED ("INCORRECT VALUE OF XPA1 (3)");
|
|
|
265 END IF;
|
|
|
266
|
|
|
267 IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
|
|
|
268 FAILED ("INCORRECT VALUE OF XPR1 (3)");
|
|
|
269 END IF;
|
|
|
270
|
|
|
271 IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(3) THEN
|
|
|
272 FAILED ("INCORRECT VALUE OF XPP1 (3)");
|
|
|
273 END IF;
|
|
|
274
|
|
|
275 IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.THREE)) THEN
|
|
|
276 FAILED ("INCORRECT VALUE OF XPV1 (3)");
|
|
|
277 END IF;
|
|
|
278
|
|
|
279 XPT1.VALU(I);
|
|
|
280 IF I /= IDENT_INT(3) THEN
|
|
|
281 FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (3)");
|
|
|
282 END IF;
|
|
|
283
|
|
|
284 XPI1 := XPI1 + 1;
|
|
|
285 XPA1 := (XPA1(1)+1, XPA1(2)+1, XPA1(3)+1);
|
|
|
286 XPR1 := (D => 1, FIELD1 => XPR1.FIELD1 + 1);
|
|
|
287 XPP1 := NEW INTEGER'(XPP1.ALL + 1);
|
|
|
288 XPV1 := PACK1.NEXT(XPV1);
|
|
|
289 XPT1.NEXT;
|
|
|
290
|
|
|
291 IF XPI1 /= IDENT_INT(4) THEN
|
|
|
292 FAILED ("INCORRECT VALUE OF XPI1 (4)");
|
|
|
293 END IF;
|
|
|
294
|
|
|
295 IF XPA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
|
|
|
296 FAILED ("INCORRECT VALUE OF XPA1 (4)");
|
|
|
297 END IF;
|
|
|
298
|
|
|
299 IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
|
|
|
300 FAILED ("INCORRECT VALUE OF XPR1 (4)");
|
|
|
301 END IF;
|
|
|
302
|
|
|
303 IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(4) THEN
|
|
|
304 FAILED ("INCORRECT VALUE OF XPP1 (4)");
|
|
|
305 END IF;
|
|
|
306
|
|
|
307 IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FOUR)) THEN
|
|
|
308 FAILED ("INCORRECT VALUE OF XPV1 (4)");
|
|
|
309 END IF;
|
|
|
310
|
|
|
311 XPT1.VALU(I);
|
|
|
312 IF I /= IDENT_INT(4) THEN
|
|
|
313 FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (4)");
|
|
|
314 END IF;
|
|
|
315
|
|
|
316 PI1 := PI1 + 1;
|
|
|
317 PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
|
|
|
318 PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
|
|
|
319 PP1 := NEW INTEGER'(PP1.ALL + 1);
|
|
|
320 PV1 := PACK1.NEXT(PV1);
|
|
|
321 PT1.NEXT;
|
|
|
322
|
|
|
323 IF XPI1 /= IDENT_INT(5) THEN
|
|
|
324 FAILED ("INCORRECT VALUE OF XPI1 (5)");
|
|
|
325 END IF;
|
|
|
326
|
|
|
327 IF XPA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
|
|
|
328 FAILED ("INCORRECT VALUE OF XPA1 (5)");
|
|
|
329 END IF;
|
|
|
330
|
|
|
331 IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
|
|
|
332 FAILED ("INCORRECT VALUE OF XPR1 (5)");
|
|
|
333 END IF;
|
|
|
334
|
|
|
335 IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(5) THEN
|
|
|
336 FAILED ("INCORRECT VALUE OF XPP1 (5)");
|
|
|
337 END IF;
|
|
|
338
|
|
|
339 IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FIVE)) THEN
|
|
|
340 FAILED ("INCORRECT VALUE OF XPV1 (5)");
|
|
|
341 END IF;
|
|
|
342
|
|
|
343 XPT1.VALU(I);
|
|
|
344 IF I /= IDENT_INT(5) THEN
|
|
|
345 FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (5)");
|
|
|
346 END IF;
|
|
|
347 END PROC;
|
|
|
348
|
|
|
349 BEGIN
|
|
|
350 TEST ("C85005B", "CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM " &
|
|
|
351 "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
|
|
|
352 "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
|
|
|
353 "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
|
|
|
354 "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
|
|
|
355 "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
|
|
|
356 "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
|
|
|
357 "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
|
|
|
358 "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
|
|
|
359 "VALUE OF THE NEW NAME");
|
|
|
360
|
|
|
361 PROC (DI1, DA1, DR1, DP1, DV1, DT1);
|
|
|
362
|
|
|
363 DT1.STOP;
|
|
|
364
|
|
|
365 RESULT;
|
|
|
366 END C85005B;
|
