|
111
|
1 -- C85006C.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY AN ENTRY
|
|
|
27 -- 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE CORRECT
|
|
|
28 -- VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
|
|
|
29 -- STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY
|
|
|
30 -- 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT'
|
|
|
31 -- PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS
|
|
|
32 -- CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
|
|
|
33
|
|
|
34 -- HISTORY:
|
|
|
35 -- JET 03/22/88 CREATED ORIGINAL TEST.
|
|
|
36
|
|
|
37 WITH REPORT; USE REPORT;
|
|
|
38 PROCEDURE C85006C 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 TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
|
|
|
75 TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
|
|
|
76 TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
|
|
|
77 TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
|
|
|
78 TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
|
|
|
79 TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
|
|
|
80
|
|
|
81 TYPE REC_TYPE IS RECORD
|
|
|
82 RI1 : INTEGER := 0;
|
|
|
83 RA1 : ARRAY1(1..3) := (OTHERS => 0);
|
|
|
84 RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
|
|
|
85 RP1 : POINTER1 := NEW INTEGER'(0);
|
|
|
86 RV1 : PACK1.PRIVY := PACK1.ZERO;
|
|
|
87 RT1 : TASK1;
|
|
|
88 END RECORD;
|
|
|
89
|
|
|
90 DREC : REC_TYPE;
|
|
|
91
|
|
|
92 DAI1 : ARR_INT(1..8) := (OTHERS => 0);
|
|
|
93 DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
|
|
|
94 DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
|
|
|
95 DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
|
|
|
96 DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
|
|
|
97 DAT1 : ARR_TSK(1..8);
|
|
|
98
|
|
|
99 I : INTEGER;
|
|
|
100
|
|
|
101 GENERIC
|
|
|
102 GRI1 : IN OUT INTEGER;
|
|
|
103 GRA1 : IN OUT ARRAY1;
|
|
|
104 GRR1 : IN OUT RECORD1;
|
|
|
105 GRP1 : IN OUT POINTER1;
|
|
|
106 GRV1 : IN OUT PACK1.PRIVY;
|
|
|
107 GRT1 : IN OUT TASK1;
|
|
|
108 GAI1 : IN OUT ARR_INT;
|
|
|
109 GAA1 : IN OUT ARR_ARR;
|
|
|
110 GAR1 : IN OUT ARR_REC;
|
|
|
111 GAP1 : IN OUT ARR_PTR;
|
|
|
112 GAV1 : IN OUT ARR_PVT;
|
|
|
113 GAT1 : IN OUT ARR_TSK;
|
|
|
114 PACKAGE GENERIC1 IS
|
|
|
115 END GENERIC1;
|
|
|
116
|
|
|
117 FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
|
|
|
118 BEGIN
|
|
|
119 IF EQUAL (3,3) THEN
|
|
|
120 RETURN P;
|
|
|
121 ELSE
|
|
|
122 RETURN NULL;
|
|
|
123 END IF;
|
|
|
124 END IDENT;
|
|
|
125
|
|
|
126 PACKAGE BODY PACK1 IS
|
|
|
127 FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
|
|
|
128 BEGIN
|
|
|
129 IF EQUAL(3,3) THEN
|
|
|
130 RETURN I;
|
|
|
131 ELSE
|
|
|
132 RETURN PRIVY'(0);
|
|
|
133 END IF;
|
|
|
134 END IDENT;
|
|
|
135
|
|
|
136 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
|
|
|
137 BEGIN
|
|
|
138 RETURN I+1;
|
|
|
139 END NEXT;
|
|
|
140 END PACK1;
|
|
|
141
|
|
|
142 PACKAGE BODY GENERIC1 IS
|
|
|
143 BEGIN
|
|
|
144 GRI1 := GRI1 + 1;
|
|
|
145 GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
|
|
|
146 GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
|
|
|
147 GRP1 := NEW INTEGER'(GRP1.ALL + 1);
|
|
|
148 GRV1 := PACK1.NEXT(GRV1);
|
|
|
149 GRT1.NEXT;
|
|
|
150 GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
|
|
|
151 GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
|
|
|
152 GAR1 := (OTHERS => (D => 1,
|
|
|
153 FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
|
|
|
154 GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
|
|
|
155 FOR J IN GAV1'RANGE LOOP
|
|
|
156 GAV1(J) := PACK1.NEXT(GAV1(J));
|
|
|
157 END LOOP;
|
|
|
158 FOR J IN GAT1'RANGE LOOP
|
|
|
159 GAT1(J).NEXT;
|
|
|
160 END LOOP;
|
|
|
161 END GENERIC1;
|
|
|
162
|
|
|
163 TASK BODY TASK1 IS
|
|
|
164 TASK_VALUE : INTEGER := 0;
|
|
|
165 ACCEPTING_ENTRIES : BOOLEAN := TRUE;
|
|
|
166 BEGIN
|
|
|
167 WHILE ACCEPTING_ENTRIES LOOP
|
|
|
168 SELECT
|
|
|
169 ACCEPT ASSIGN (J : IN INTEGER) DO
|
|
|
170 TASK_VALUE := J;
|
|
|
171 END ASSIGN;
|
|
|
172 OR
|
|
|
173 ACCEPT VALU (J : OUT INTEGER) DO
|
|
|
174 J := TASK_VALUE;
|
|
|
175 END VALU;
|
|
|
176 OR
|
|
|
177 ACCEPT NEXT DO
|
|
|
178 TASK_VALUE := TASK_VALUE + 1;
|
|
|
179 END NEXT;
|
|
|
180 OR
|
|
|
181 ACCEPT STOP DO
|
|
|
182 ACCEPTING_ENTRIES := FALSE;
|
|
|
183 END STOP;
|
|
|
184 END SELECT;
|
|
|
185 END LOOP;
|
|
|
186 END TASK1;
|
|
|
187
|
|
|
188 BEGIN
|
|
|
189 TEST ("C85006C", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
|
|
|
190 "CREATED BY AN ENTRY 'IN OUT' FORMAL PARAMETER " &
|
|
|
191 "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
|
|
|
192 "THAT THE NEW NAME CAN BE USED IN AN ASSIGN" &
|
|
|
193 "MENT STATEMENT AND PASSED ON AS AN ACTUAL " &
|
|
|
194 "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
|
|
|
195 "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
|
|
|
196 "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
|
|
|
197 "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
|
|
|
198 "REFLECTED BY THE VALUE OF THE NEW NAME");
|
|
|
199
|
|
|
200 DECLARE
|
|
|
201 TASK MAIN_TASK IS
|
|
|
202 ENTRY START (REC : IN OUT REC_TYPE;
|
|
|
203 AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
|
|
|
204 AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
|
|
|
205 AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK);
|
|
|
206 END MAIN_TASK;
|
|
|
207
|
|
|
208 TASK BODY MAIN_TASK IS
|
|
|
209 BEGIN
|
|
|
210 ACCEPT START (REC : IN OUT REC_TYPE;
|
|
|
211 AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
|
|
|
212 AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
|
|
|
213 AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK)
|
|
|
214 DO
|
|
|
215 DECLARE
|
|
|
216 XRI1 : INTEGER RENAMES REC.RI1;
|
|
|
217 XRA1 : ARRAY1 RENAMES REC.RA1;
|
|
|
218 XRR1 : RECORD1 RENAMES REC.RR1;
|
|
|
219 XRP1 : POINTER1 RENAMES REC.RP1;
|
|
|
220 XRV1 : PACK1.PRIVY RENAMES REC.RV1;
|
|
|
221 XRT1 : TASK1 RENAMES REC.RT1;
|
|
|
222 XAI1 : ARR_INT RENAMES AI1(1..3);
|
|
|
223 XAA1 : ARR_ARR RENAMES AA1(2..4);
|
|
|
224 XAR1 : ARR_REC RENAMES AR1(3..5);
|
|
|
225 XAP1 : ARR_PTR RENAMES AP1(4..6);
|
|
|
226 XAV1 : ARR_PVT RENAMES AV1(5..7);
|
|
|
227 XAT1 : ARR_TSK RENAMES AT1(6..8);
|
|
|
228
|
|
|
229 TASK TYPE TASK2 IS
|
|
|
230 ENTRY ENTRY1 (TRI1 : OUT INTEGER;
|
|
|
231 TRA1 : OUT ARRAY1;
|
|
|
232 TRR1 : OUT RECORD1;
|
|
|
233 TRP1 : IN OUT POINTER1;
|
|
|
234 TRV1 : IN OUT PACK1.PRIVY;
|
|
|
235 TRT1 : IN OUT TASK1;
|
|
|
236 TAI1 : OUT ARR_INT;
|
|
|
237 TAA1 : OUT ARR_ARR;
|
|
|
238 TAR1 : OUT ARR_REC;
|
|
|
239 TAP1 : IN OUT ARR_PTR;
|
|
|
240 TAV1 : IN OUT ARR_PVT;
|
|
|
241 TAT1 : IN OUT ARR_TSK);
|
|
|
242 END TASK2;
|
|
|
243
|
|
|
244 CHK_TASK : TASK2;
|
|
|
245
|
|
|
246 TASK BODY TASK2 IS
|
|
|
247 BEGIN
|
|
|
248 ACCEPT ENTRY1 (TRI1 : OUT INTEGER;
|
|
|
249 TRA1 : OUT ARRAY1;
|
|
|
250 TRR1 : OUT RECORD1;
|
|
|
251 TRP1 : IN OUT POINTER1;
|
|
|
252 TRV1 : IN OUT PACK1.PRIVY;
|
|
|
253 TRT1: IN OUT TASK1;
|
|
|
254 TAI1 : OUT ARR_INT;
|
|
|
255 TAA1 : OUT ARR_ARR;
|
|
|
256 TAR1 : OUT ARR_REC;
|
|
|
257 TAP1 : IN OUT ARR_PTR;
|
|
|
258 TAV1 : IN OUT ARR_PVT;
|
|
|
259 TAT1 : IN OUT ARR_TSK)
|
|
|
260 DO
|
|
|
261 TRI1 := REC.RI1 + 1;
|
|
|
262 TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
|
|
|
263 REC.RA1(3)+1);
|
|
|
264 TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
|
|
|
265 TRP1 := NEW INTEGER'(TRP1.ALL + 1);
|
|
|
266 TRV1 := PACK1.NEXT(TRV1);
|
|
|
267 TRT1.NEXT;
|
|
|
268 TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
|
|
|
269 TAA1 := (OTHERS => (OTHERS =>
|
|
|
270 AA1(TAA1'FIRST)(1) + 1));
|
|
|
271 TAR1 := (OTHERS => (D => 1, FIELD1 =>
|
|
|
272 (AR1(TAR1'FIRST).FIELD1 + 1)));
|
|
|
273 TAP1 := (OTHERS =>
|
|
|
274 NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
|
|
|
275 FOR J IN TAV1'RANGE LOOP
|
|
|
276 TAV1(J) := PACK1.NEXT(TAV1(J));
|
|
|
277 END LOOP;
|
|
|
278 FOR J IN TAT1'RANGE LOOP
|
|
|
279 TAT1(J).NEXT;
|
|
|
280 END LOOP;
|
|
|
281 END ENTRY1;
|
|
|
282 END TASK2;
|
|
|
283
|
|
|
284 PROCEDURE PROC1 (PRI1 : IN OUT INTEGER;
|
|
|
285 PRA1 : IN OUT ARRAY1;
|
|
|
286 PRR1 : IN OUT RECORD1;
|
|
|
287 PRP1 : OUT POINTER1;
|
|
|
288 PRV1 : OUT PACK1.PRIVY;
|
|
|
289 PRT1 : IN OUT TASK1;
|
|
|
290 PAI1 : IN OUT ARR_INT;
|
|
|
291 PAA1 : IN OUT ARR_ARR;
|
|
|
292 PAR1 : IN OUT ARR_REC;
|
|
|
293 PAP1 : OUT ARR_PTR;
|
|
|
294 PAV1 : OUT ARR_PVT;
|
|
|
295 PAT1 : IN OUT ARR_TSK) IS
|
|
|
296 BEGIN
|
|
|
297 PRI1 := PRI1 + 1;
|
|
|
298 PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
|
|
|
299 PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
|
|
|
300 PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
|
|
|
301 PRV1 := PACK1.NEXT(REC.RV1);
|
|
|
302 PRT1.NEXT;
|
|
|
303 PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
|
|
|
304 PAA1 := (OTHERS => (OTHERS =>
|
|
|
305 PAA1(PAA1'FIRST)(1) + 1));
|
|
|
306 PAR1 := (OTHERS => (D => 1, FIELD1 =>
|
|
|
307 (PAR1(PAR1'FIRST).FIELD1+1)));
|
|
|
308 PAP1 := (OTHERS =>
|
|
|
309 NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
|
|
|
310 FOR J IN PAV1'RANGE LOOP
|
|
|
311 PAV1(J) := PACK1.NEXT(AV1(J));
|
|
|
312 END LOOP;
|
|
|
313 FOR J IN PAT1'RANGE LOOP
|
|
|
314 PAT1(J).NEXT;
|
|
|
315 END LOOP;
|
|
|
316 END PROC1;
|
|
|
317
|
|
|
318 PACKAGE GENPACK2 IS NEW GENERIC1
|
|
|
319 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
|
|
|
320 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
|
|
|
321
|
|
|
322 BEGIN
|
|
|
323 IF XRI1 /= IDENT_INT(1) THEN
|
|
|
324 FAILED ("INCORRECT VALUE OF XRI1 (1)");
|
|
|
325 END IF;
|
|
|
326
|
|
|
327 IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),
|
|
|
328 IDENT_INT(1)) THEN
|
|
|
329 FAILED ("INCORRECT VALUE OF XRA1 (1)");
|
|
|
330 END IF;
|
|
|
331
|
|
|
332 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1))
|
|
|
333 THEN
|
|
|
334 FAILED ("INCORRECT VALUE OF XRR1 (1)");
|
|
|
335 END IF;
|
|
|
336
|
|
|
337 IF XRP1 /= IDENT(REC.RP1) OR
|
|
|
338 XRP1.ALL /= IDENT_INT(1) THEN
|
|
|
339 FAILED ("INCORRECT VALUE OF XRP1 (1)");
|
|
|
340 END IF;
|
|
|
341
|
|
|
342 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE))
|
|
|
343 THEN
|
|
|
344 FAILED ("INCORRECT VALUE OF XRV1 (1)");
|
|
|
345 END IF;
|
|
|
346
|
|
|
347 XRT1.VALU(I);
|
|
|
348 IF I /= IDENT_INT(1) THEN
|
|
|
349 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
350 "XRT1.VALU (1)");
|
|
|
351 END IF;
|
|
|
352
|
|
|
353 FOR J IN XAI1'RANGE LOOP
|
|
|
354 IF XAI1(J) /= IDENT_INT(1) THEN
|
|
|
355 FAILED ("INCORRECT VALUE OF XAI1(" &
|
|
|
356 INTEGER'IMAGE(J) & ") (1)");
|
|
|
357 END IF;
|
|
|
358 END LOOP;
|
|
|
359
|
|
|
360 FOR J IN XAA1'RANGE LOOP
|
|
|
361 IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),
|
|
|
362 IDENT_INT(1)) THEN
|
|
|
363 FAILED ("INCORRECT VALUE OF XAA1(" &
|
|
|
364 INTEGER'IMAGE(J) & ") (1)");
|
|
|
365 END IF;
|
|
|
366 END LOOP;
|
|
|
367
|
|
|
368 FOR J IN XAR1'RANGE LOOP
|
|
|
369 IF XAR1(J) /= (D => 1,
|
|
|
370 FIELD1 => IDENT_INT(1)) THEN
|
|
|
371 FAILED ("INCORRECT VALUE OF XAR1(" &
|
|
|
372 INTEGER'IMAGE(J) & ") (1)");
|
|
|
373 END IF;
|
|
|
374 END LOOP;
|
|
|
375
|
|
|
376 FOR J IN XAP1'RANGE LOOP
|
|
|
377 IF XAP1(J) /= IDENT(AP1(J)) OR
|
|
|
378 XAP1(J).ALL /= IDENT_INT(1) THEN
|
|
|
379 FAILED ("INCORRECT VALUE OF XAP1(" &
|
|
|
380 INTEGER'IMAGE(J) & ") (1)");
|
|
|
381 END IF;
|
|
|
382 END LOOP;
|
|
|
383
|
|
|
384 FOR J IN XAV1'RANGE LOOP
|
|
|
385 IF PACK1."/=" (XAV1(J),
|
|
|
386 PACK1.IDENT(PACK1.ONE)) THEN
|
|
|
387 FAILED ("INCORRECT VALUE OF XAV1(" &
|
|
|
388 INTEGER'IMAGE(J) & ") (1)");
|
|
|
389 END IF;
|
|
|
390 END LOOP;
|
|
|
391
|
|
|
392 FOR J IN XAT1'RANGE LOOP
|
|
|
393 XAT1(J).VALU(I);
|
|
|
394 IF I /= IDENT_INT(1) THEN
|
|
|
395 FAILED ("INCORRECT RETURN VALUE " &
|
|
|
396 "FROM XAT1(" & INTEGER'IMAGE(J) &
|
|
|
397 ").VALU (1)");
|
|
|
398 END IF;
|
|
|
399 END LOOP;
|
|
|
400
|
|
|
401 PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
|
|
|
402 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
|
|
|
403
|
|
|
404 IF XRI1 /= IDENT_INT(2) THEN
|
|
|
405 FAILED ("INCORRECT VALUE OF XRI1 (2)");
|
|
|
406 END IF;
|
|
|
407
|
|
|
408 IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),
|
|
|
409 IDENT_INT(2)) THEN
|
|
|
410 FAILED ("INCORRECT VALUE OF XRA1 (2)");
|
|
|
411 END IF;
|
|
|
412
|
|
|
413 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2))
|
|
|
414 THEN
|
|
|
415 FAILED ("INCORRECT VALUE OF XRR1 (2)");
|
|
|
416 END IF;
|
|
|
417
|
|
|
418 IF XRP1 /= IDENT(REC.RP1) OR
|
|
|
419 XRP1.ALL /= IDENT_INT(2) THEN
|
|
|
420 FAILED ("INCORRECT VALUE OF XRP1 (2)");
|
|
|
421 END IF;
|
|
|
422
|
|
|
423 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO))
|
|
|
424 THEN
|
|
|
425 FAILED ("INCORRECT VALUE OF XRV1 (2)");
|
|
|
426 END IF;
|
|
|
427
|
|
|
428 XRT1.VALU(I);
|
|
|
429 IF I /= IDENT_INT(2) THEN
|
|
|
430 FAILED ("INCORRECT RETURN VALUE FROM " &
|
|
|
431 "XRT1.VALU (2)");
|
|
|
432 END IF;
|
|
|
433
|
|
|
434 FOR J IN XAI1'RANGE LOOP
|
|
|
435 IF XAI1(J) /= IDENT_INT(2) THEN
|
|
|
436 FAILED ("INCORRECT VALUE OF XAI1(" &
|
|
|
437 INTEGER'IMAGE(J) & ") (2)");
|
|
|
438 END IF;
|
|
|
439 END LOOP;
|
|
|
440
|
|
|
441 FOR J IN XAA1'RANGE LOOP
|
|
|
442 IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),
|
|
|
443 IDENT_INT(2)) THEN
|
|
|
444 FAILED ("INCORRECT VALUE OF XAA1(" &
|
|
|
445 INTEGER'IMAGE(J) & ") (2)");
|
|
|
446 END IF;
|
|
|
447 END LOOP;
|
|
|
448
|
|
|
449 FOR J IN XAR1'RANGE LOOP
|
|
|
450 IF XAR1(J) /= (D => 1,
|
|
|
451 FIELD1 => IDENT_INT(2)) THEN
|
|
|
452 FAILED ("INCORRECT VALUE OF XAR1(" &
|
|
|
453 INTEGER'IMAGE(J) & ") (2)");
|
|
|
454 END IF;
|
|
|
455 END LOOP;
|
|
|
456
|
|
|
457 FOR J IN XAP1'RANGE LOOP
|
|
|
458 IF XAP1(J) /= IDENT(AP1(J)) OR
|
|
|
459 XAP1(J).ALL /= IDENT_INT(2) THEN
|
|
|
460 FAILED ("INCORRECT VALUE OF XAP1(" &
|
|
|
461 INTEGER'IMAGE(J) & ") (2)");
|
|
|
462 END IF;
|
|
|
463 END LOOP;
|
|
|
464
|
|
|
465 FOR J IN XAV1'RANGE LOOP
|
|
|
466 IF PACK1."/=" (XAV1(J),
|
|
|
467 PACK1.IDENT(PACK1.TWO)) THEN
|
|
|
468 FAILED ("INCORRECT VALUE OF XAV1(" &
|
|
|
469 INTEGER'IMAGE(J) & ") (2)");
|
|
|
470 END IF;
|
|
|
471 END LOOP;
|
|
|
472
|
|
|
473 FOR J IN XAT1'RANGE LOOP
|
|
|
474 XAT1(J).VALU(I);
|
|
|
475 IF I /= IDENT_INT(2) THEN
|
|
|
476 FAILED ("INCORRECT RETURN VALUE " &
|
|
|
477 "FROM XAT1(" & INTEGER'IMAGE(J) &
|
|
|
478 ").VALU (2)");
|
|
|
479 END IF;
|
|
|
480 END LOOP;
|
|
|
481
|
|
|
482 CHK_TASK.ENTRY1
|
|
|
483 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
|
|
|
484 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
|
|
|
485
|
|
|
486 IF XRI1 /= IDENT_INT(3) THEN
|
|
|
487 FAILED ("INCORRECT VALUE OF XRI1 (3)");
|
|
|
488 END IF;
|
|
|
489
|
|
|
490 IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),
|
|
|
491 IDENT_INT(3)) THEN
|
|
|
492 FAILED ("INCORRECT VALUE OF XRA1 (3)");
|
|
|
493 END IF;
|
|
|
494
|
|
|
495 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3))
|
|
|
496 THEN
|
|
|
497 FAILED ("INCORRECT VALUE OF XRR1 (3)");
|
|
|
498 END IF;
|
|
|
499
|
|
|
500 IF XRP1 /= IDENT(REC.RP1) OR
|
|
|
501 XRP1.ALL /= IDENT_INT(3) THEN
|
|
|
502 FAILED ("INCORRECT VALUE OF XRP1 (3)");
|
|
|
503 END IF;
|
|
|
504
|
|
|
505 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE))
|
|
|
506 THEN
|
|
|
507 FAILED ("INCORRECT VALUE OF XRV1 (3)");
|
|
|
508 END IF;
|
|
|
509
|
|
|
510 XRT1.VALU(I);
|
|
|
511 IF I /= IDENT_INT(3) THEN
|
|
|
512 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
513 "XRT1.VALU (3)");
|
|
|
514 END IF;
|
|
|
515
|
|
|
516 FOR J IN XAI1'RANGE LOOP
|
|
|
517 IF XAI1(J) /= IDENT_INT(3) THEN
|
|
|
518 FAILED ("INCORRECT VALUE OF XAI1(" &
|
|
|
519 INTEGER'IMAGE(J) & ") (3)");
|
|
|
520 END IF;
|
|
|
521 END LOOP;
|
|
|
522
|
|
|
523 FOR J IN XAA1'RANGE LOOP
|
|
|
524 IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),
|
|
|
525 IDENT_INT(3))
|
|
|
526 THEN
|
|
|
527 FAILED ("INCORRECT VALUE OF XAA1(" &
|
|
|
528 INTEGER'IMAGE(J) & ") (3)");
|
|
|
529 END IF;
|
|
|
530 END LOOP;
|
|
|
531
|
|
|
532 FOR J IN XAR1'RANGE LOOP
|
|
|
533 IF XAR1(J) /= (D => 1,
|
|
|
534 FIELD1 => IDENT_INT(3)) THEN
|
|
|
535 FAILED ("INCORRECT VALUE OF XAR1(" &
|
|
|
536 INTEGER'IMAGE(J) & ") (3)");
|
|
|
537 END IF;
|
|
|
538 END LOOP;
|
|
|
539
|
|
|
540 FOR J IN XAP1'RANGE LOOP
|
|
|
541 IF XAP1(J) /= IDENT(AP1(J)) OR
|
|
|
542 XAP1(J).ALL /= IDENT_INT(3) THEN
|
|
|
543 FAILED ("INCORRECT VALUE OF XAP1(" &
|
|
|
544 INTEGER'IMAGE(J) & ") (3)");
|
|
|
545 END IF;
|
|
|
546 END LOOP;
|
|
|
547
|
|
|
548 FOR J IN XAV1'RANGE LOOP
|
|
|
549 IF PACK1."/=" (XAV1(J),
|
|
|
550 PACK1.IDENT(PACK1.THREE)) THEN
|
|
|
551 FAILED ("INCORRECT VALUE OF XAV1(" &
|
|
|
552 INTEGER'IMAGE(J) & ") (3)");
|
|
|
553 END IF;
|
|
|
554 END LOOP;
|
|
|
555
|
|
|
556 FOR J IN XAT1'RANGE LOOP
|
|
|
557 XAT1(J).VALU(I);
|
|
|
558 IF I /= IDENT_INT(3) THEN
|
|
|
559 FAILED ("INCORRECT RETURN VALUE " &
|
|
|
560 "FROM XAT1(" &
|
|
|
561 INTEGER'IMAGE(J) & ").VALU (3)");
|
|
|
562 END IF;
|
|
|
563 END LOOP;
|
|
|
564
|
|
|
565 XRI1 := XRI1 + 1;
|
|
|
566 XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
|
|
|
567 XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
|
|
|
568 XRP1 := NEW INTEGER'(XRP1.ALL + 1);
|
|
|
569 XRV1 := PACK1.NEXT(XRV1);
|
|
|
570 XRT1.NEXT;
|
|
|
571 XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
|
|
|
572 XAA1 := (OTHERS =>
|
|
|
573 (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
|
|
|
574 XAR1 := (OTHERS => (D => 1, FIELD1 =>
|
|
|
575 (XAR1(XAR1'FIRST).FIELD1 + 1)));
|
|
|
576 XAP1 := (OTHERS =>
|
|
|
577 NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
|
|
|
578 FOR J IN XAV1'RANGE LOOP
|
|
|
579 XAV1(J) := PACK1.NEXT(XAV1(J));
|
|
|
580 END LOOP;
|
|
|
581 FOR J IN XAT1'RANGE LOOP
|
|
|
582 XAT1(J).NEXT;
|
|
|
583 END LOOP;
|
|
|
584
|
|
|
585 IF XRI1 /= IDENT_INT(4) THEN
|
|
|
586 FAILED ("INCORRECT VALUE OF XRI1 (4)");
|
|
|
587 END IF;
|
|
|
588
|
|
|
589 IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),
|
|
|
590 IDENT_INT(4)) THEN
|
|
|
591 FAILED ("INCORRECT VALUE OF XRA1 (4)");
|
|
|
592 END IF;
|
|
|
593
|
|
|
594 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4))
|
|
|
595 THEN
|
|
|
596 FAILED ("INCORRECT VALUE OF XRR1 (4)");
|
|
|
597 END IF;
|
|
|
598
|
|
|
599 IF XRP1 /= IDENT(REC.RP1) OR
|
|
|
600 XRP1.ALL /= IDENT_INT(4) THEN
|
|
|
601 FAILED ("INCORRECT VALUE OF XRP1 (4)");
|
|
|
602 END IF;
|
|
|
603
|
|
|
604 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR))
|
|
|
605 THEN
|
|
|
606 FAILED ("INCORRECT VALUE OF XRV1 (4)");
|
|
|
607 END IF;
|
|
|
608
|
|
|
609 XRT1.VALU(I);
|
|
|
610 IF I /= IDENT_INT(4) THEN
|
|
|
611 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
612 "XRT1.VALU (4)");
|
|
|
613 END IF;
|
|
|
614
|
|
|
615 FOR J IN XAI1'RANGE LOOP
|
|
|
616 IF XAI1(J) /= IDENT_INT(4) THEN
|
|
|
617 FAILED ("INCORRECT VALUE OF XAI1(" &
|
|
|
618 INTEGER'IMAGE(J) & ") (4)");
|
|
|
619 END IF;
|
|
|
620 END LOOP;
|
|
|
621
|
|
|
622 FOR J IN XAA1'RANGE LOOP
|
|
|
623 IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),
|
|
|
624 IDENT_INT(4)) THEN
|
|
|
625 FAILED ("INCORRECT VALUE OF XAA1(" &
|
|
|
626 INTEGER'IMAGE(J) & ") (4)");
|
|
|
627 END IF;
|
|
|
628 END LOOP;
|
|
|
629
|
|
|
630 FOR J IN XAR1'RANGE LOOP
|
|
|
631 IF XAR1(J) /= (D => 1, FIELD1 =>
|
|
|
632 IDENT_INT(4)) THEN
|
|
|
633 FAILED ("INCORRECT VALUE OF XAR1(" &
|
|
|
634 INTEGER'IMAGE(J) & ") (4)");
|
|
|
635 END IF;
|
|
|
636 END LOOP;
|
|
|
637
|
|
|
638 FOR J IN XAP1'RANGE LOOP
|
|
|
639 IF XAP1(J) /= IDENT(AP1(J)) OR
|
|
|
640 XAP1(J).ALL /= IDENT_INT(4) THEN
|
|
|
641 FAILED ("INCORRECT VALUE OF XAP1(" &
|
|
|
642 INTEGER'IMAGE(J) & ") (4)");
|
|
|
643 END IF;
|
|
|
644 END LOOP;
|
|
|
645
|
|
|
646 FOR J IN XAV1'RANGE LOOP
|
|
|
647 IF PACK1."/=" (XAV1(J),
|
|
|
648 PACK1.IDENT(PACK1.FOUR)) THEN
|
|
|
649 FAILED ("INCORRECT VALUE OF XAV1(" &
|
|
|
650 INTEGER'IMAGE(J) & ") (4)");
|
|
|
651 END IF;
|
|
|
652 END LOOP;
|
|
|
653
|
|
|
654 FOR J IN XAT1'RANGE LOOP
|
|
|
655 XAT1(J).VALU(I);
|
|
|
656 IF I /= IDENT_INT(4) THEN
|
|
|
657 FAILED ("INCORRECT RETURN VALUE " &
|
|
|
658 "FROM XAT1(" &
|
|
|
659 INTEGER'IMAGE(J) & ").VALU (4)");
|
|
|
660 END IF;
|
|
|
661 END LOOP;
|
|
|
662
|
|
|
663 REC.RI1 := REC.RI1 + 1;
|
|
|
664 REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
|
|
|
665 REC.RA1(3)+1);
|
|
|
666 REC.RR1 := (D => 1, FIELD1 =>
|
|
|
667 REC.RR1.FIELD1 + 1);
|
|
|
668 REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
|
|
|
669 REC.RV1 := PACK1.NEXT(REC.RV1);
|
|
|
670 REC.RT1.NEXT;
|
|
|
671 AI1(XAI1'RANGE) := (OTHERS =>
|
|
|
672 AI1(XAI1'FIRST) + 1);
|
|
|
673 AA1(XAA1'RANGE) := (OTHERS =>
|
|
|
674 (OTHERS => AA1(XAA1'FIRST)(1) + 1));
|
|
|
675 AR1(XAR1'RANGE) := (OTHERS => (D => 1,
|
|
|
676 FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
|
|
|
677 AP1(XAP1'RANGE) := (OTHERS =>
|
|
|
678 NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
|
|
|
679 FOR J IN XAV1'RANGE LOOP
|
|
|
680 AV1(J) := PACK1.NEXT(AV1(J));
|
|
|
681 END LOOP;
|
|
|
682 FOR J IN XAT1'RANGE LOOP
|
|
|
683 AT1(J).NEXT;
|
|
|
684 END LOOP;
|
|
|
685
|
|
|
686 IF XRI1 /= IDENT_INT(5) THEN
|
|
|
687 FAILED ("INCORRECT VALUE OF XRI1 (5)");
|
|
|
688 END IF;
|
|
|
689
|
|
|
690 IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),
|
|
|
691 IDENT_INT(5)) THEN
|
|
|
692 FAILED ("INCORRECT VALUE OF XRA1 (5)");
|
|
|
693 END IF;
|
|
|
694
|
|
|
695 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5))
|
|
|
696 THEN
|
|
|
697 FAILED ("INCORRECT VALUE OF XRR1 (5)");
|
|
|
698 END IF;
|
|
|
699
|
|
|
700 IF XRP1 /= IDENT(REC.RP1) OR
|
|
|
701 XRP1.ALL /= IDENT_INT(5) THEN
|
|
|
702 FAILED ("INCORRECT VALUE OF XRP1 (5)");
|
|
|
703 END IF;
|
|
|
704
|
|
|
705 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE))
|
|
|
706 THEN
|
|
|
707 FAILED ("INCORRECT VALUE OF XRV1 (5)");
|
|
|
708 END IF;
|
|
|
709
|
|
|
710 XRT1.VALU(I);
|
|
|
711 IF I /= IDENT_INT(5) THEN
|
|
|
712 FAILED ("INCORRECT RETURN VALUE OF " &
|
|
|
713 "XRT1.VALU (5)");
|
|
|
714 END IF;
|
|
|
715
|
|
|
716 FOR J IN XAI1'RANGE LOOP
|
|
|
717 IF XAI1(J) /= IDENT_INT(5) THEN
|
|
|
718 FAILED ("INCORRECT VALUE OF XAI1(" &
|
|
|
719 INTEGER'IMAGE(J) & ") (5)");
|
|
|
720 END IF;
|
|
|
721 END LOOP;
|
|
|
722
|
|
|
723 FOR J IN XAA1'RANGE LOOP
|
|
|
724 IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),
|
|
|
725 IDENT_INT(5)) THEN
|
|
|
726 FAILED ("INCORRECT VALUE OF XAA1(" &
|
|
|
727 INTEGER'IMAGE(J) & ") (5)");
|
|
|
728 END IF;
|
|
|
729 END LOOP;
|
|
|
730
|
|
|
731 FOR J IN XAR1'RANGE LOOP
|
|
|
732 IF XAR1(J) /= (D => 1, FIELD1 =>
|
|
|
733 IDENT_INT(5)) THEN
|
|
|
734 FAILED ("INCORRECT VALUE OF XAR1(" &
|
|
|
735 INTEGER'IMAGE(J) & ") (5)");
|
|
|
736 END IF;
|
|
|
737 END LOOP;
|
|
|
738
|
|
|
739 FOR J IN XAP1'RANGE LOOP
|
|
|
740 IF XAP1(J) /= IDENT(AP1(J)) OR
|
|
|
741 XAP1(J).ALL /= IDENT_INT(5) THEN
|
|
|
742 FAILED ("INCORRECT VALUE OF XAP1(" &
|
|
|
743 INTEGER'IMAGE(J) & ") (5)");
|
|
|
744 END IF;
|
|
|
745 END LOOP;
|
|
|
746
|
|
|
747 FOR J IN XAV1'RANGE LOOP
|
|
|
748 IF PACK1."/=" (XAV1(J),
|
|
|
749 PACK1.IDENT(PACK1.FIVE)) THEN
|
|
|
750 FAILED ("INCORRECT VALUE OF XAV1(" &
|
|
|
751 INTEGER'IMAGE(J) & ") (5)");
|
|
|
752 END IF;
|
|
|
753 END LOOP;
|
|
|
754
|
|
|
755 FOR J IN XAT1'RANGE LOOP
|
|
|
756 XAT1(J).VALU(I);
|
|
|
757 IF I /= IDENT_INT(5) THEN
|
|
|
758 FAILED ("INCORRECT RETURN VALUE " &
|
|
|
759 "FROM XAT1(" &
|
|
|
760 INTEGER'IMAGE(J) & ").VALU (5)");
|
|
|
761 END IF;
|
|
|
762 END LOOP;
|
|
|
763 END;
|
|
|
764 END START;
|
|
|
765 END MAIN_TASK;
|
|
|
766
|
|
|
767 BEGIN
|
|
|
768 MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
|
|
|
769 END;
|
|
|
770
|
|
|
771 DREC.RT1.STOP;
|
|
|
772
|
|
|
773 FOR I IN DAT1'RANGE LOOP
|
|
|
774 DAT1(I).STOP;
|
|
|
775 END LOOP;
|
|
|
776
|
|
|
777 RESULT;
|
|
|
778 END C85006C;
|
