Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c8/c85006b.ada @ 111:04ced10e8804

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