3 -- Grant of Unlimited Rights
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
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.
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.
35 -- JET 03/22/88 CREATED ORIGINAL TEST.
37 WITH REPORT
; USE REPORT
;
40 TYPE ARRAY1
IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
41 TYPE RECORD1
(D
: INTEGER) IS
43 FIELD1
: INTEGER := 1;
45 TYPE POINTER1
IS ACCESS INTEGER;
48 TYPE PRIVY
IS PRIVATE;
49 ZERO
: 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
;
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;
68 ENTRY ASSIGN
(J
: IN INTEGER);
69 ENTRY VALU
(J
: OUT INTEGER);
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
;
81 TYPE REC_TYPE
IS RECORD
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;
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
);
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
;
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
;
115 FUNCTION IDENT
(P
: POINTER1
) RETURN POINTER1
IS
124 PACKAGE BODY PACK1
IS
125 FUNCTION IDENT
(I
: PRIVY
) RETURN PRIVY
IS
134 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
140 PACKAGE BODY GENERIC1 IS
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
);
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));
156 FOR J IN GAT1'RANGE LOOP
162 TASK_VALUE : INTEGER := 0;
163 ACCEPTING_ENTRIES : BOOLEAN := TRUE;
165 WHILE ACCEPTING_ENTRIES LOOP
167 ACCEPT ASSIGN (J : IN INTEGER) DO
171 ACCEPT VALU (J : OUT INTEGER) DO
176 TASK_VALUE := TASK_VALUE + 1;
180 ACCEPTING_ENTRIES := FALSE;
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
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);
205 ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
206 TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
207 TRV1 : IN OUT PACK1.PRIVY;
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);
220 ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
222 TRP1 : IN OUT POINTER1;
223 TRV1 : IN OUT PACK1.PRIVY;
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)
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
);
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)));
242 NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
243 FOR J IN TAV1'RANGE LOOP
244 TAV1(J) := PACK1.NEXT(TAV1(J));
246 FOR J IN TAT1'RANGE LOOP
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
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
);
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));
273 FOR J IN PAT1'RANGE LOOP
278 PACKAGE GENPACK1 IS NEW
279 GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
280 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
283 IF XRI1 /= IDENT_INT(1) THEN
284 FAILED ("INCORRECT VALUE OF XRI1 (1)");
287 IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
288 FAILED ("INCORRECT VALUE OF XRA1 (1)");
291 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
292 FAILED ("INCORRECT VALUE OF XRR1 (1)");
295 IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
296 FAILED ("INCORRECT VALUE OF XRP1 (1)");
299 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
300 FAILED ("INCORRECT VALUE OF XRV1 (1)");
304 IF I /= IDENT_INT(1) THEN
305 FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
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)");
315 FOR J IN XAA1'RANGE LOOP
316 IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
318 FAILED ("INCORRECT VALUE OF XAA1(" &
319 INTEGER'IMAGE(J) & ") (1)");
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)");
330 FOR J IN XAP1'RANGE LOOP
331 IF XAP1(J) /= IDENT(AP1(J)) OR
332 XAP1(J).ALL /= IDENT_INT(1)
334 FAILED ("INCORRECT VALUE OF XAP1(" &
335 INTEGER'IMAGE(J) & ") (1)");
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)");
346 FOR J IN XAT1'RANGE LOOP
348 IF I /= IDENT_INT(1) THEN
349 FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
350 INTEGER'IMAGE(J) & ").VALU (1)");
354 PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
355 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
357 IF XRI1 /= IDENT_INT(2) THEN
358 FAILED ("INCORRECT VALUE OF XRI1 (2)");
361 IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
362 FAILED ("INCORRECT VALUE OF XRA1 (2)");
365 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
366 FAILED ("INCORRECT VALUE OF XRR1 (2)");
369 IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
370 FAILED ("INCORRECT VALUE OF XRP1 (2)");
373 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
374 FAILED ("INCORRECT VALUE OF XRV1 (2)");
378 IF I /= IDENT_INT(2) THEN
379 FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
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)");
389 FOR J IN XAA1'RANGE LOOP
390 IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
392 FAILED ("INCORRECT VALUE OF XAA1(" &
393 INTEGER'IMAGE(J) & ") (2)");
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)");
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)");
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)");
419 FOR J IN XAT1'RANGE LOOP
421 IF I /= IDENT_INT(2) THEN
422 FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
423 INTEGER'IMAGE(J) & ").VALU (2)");
427 CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
428 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
430 IF XRI1 /= IDENT_INT(3) THEN
431 FAILED ("INCORRECT VALUE OF XRI1 (3)");
434 IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
435 FAILED ("INCORRECT VALUE OF XRA1 (3)");
438 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
439 FAILED ("INCORRECT VALUE OF XRR1 (3)");
442 IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
443 FAILED ("INCORRECT VALUE OF XRP1 (3)");
446 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
447 FAILED ("INCORRECT VALUE OF XRV1 (3)");
451 IF I /= IDENT_INT(3) THEN
452 FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
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)");
462 FOR J IN XAA1'RANGE LOOP
463 IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
465 FAILED ("INCORRECT VALUE OF XAA1(" &
466 INTEGER'IMAGE(J) & ") (3)");
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)");
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)");
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)");
492 FOR J IN XAT1'RANGE LOOP
494 IF I /= IDENT_INT(3) THEN
495 FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
496 INTEGER'IMAGE(J) & ").VALU (3)");
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
);
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));
514 FOR J IN XAT1'RANGE LOOP
518 IF XRI1 /= IDENT_INT(4) THEN
519 FAILED ("INCORRECT VALUE OF XRI1 (4)");
522 IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
523 FAILED ("INCORRECT VALUE OF XRA1 (4)");
526 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
527 FAILED ("INCORRECT VALUE OF XRR1 (4)");
530 IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
531 FAILED ("INCORRECT VALUE OF XRP1 (4)");
534 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
535 FAILED ("INCORRECT VALUE OF XRV1 (4)");
539 IF I /= IDENT_INT(4) THEN
540 FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
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)");
550 FOR J IN XAA1'RANGE LOOP
551 IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
553 FAILED ("INCORRECT VALUE OF XAA1(" &
554 INTEGER'IMAGE(J) & ") (4)");
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)");
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)");
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)");
580 FOR J IN XAT1'RANGE LOOP
582 IF I /= IDENT_INT(4) THEN
583 FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
584 INTEGER'IMAGE(J) & ").VALU (4)");
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
);
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));
602 FOR J IN XAT1'RANGE LOOP
606 IF XRI1 /= IDENT_INT(5) THEN
607 FAILED ("INCORRECT VALUE OF XRI1 (5)");
610 IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
611 FAILED ("INCORRECT VALUE OF XRA1 (5)");
614 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
615 FAILED ("INCORRECT VALUE OF XRR1 (5)");
618 IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
619 FAILED ("INCORRECT VALUE OF XRP1 (5)");
622 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
623 FAILED ("INCORRECT VALUE OF XRV1 (5)");
627 IF I /= IDENT_INT(5) THEN
628 FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
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)");
638 FOR J IN XAA1'RANGE LOOP
639 IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
641 FAILED ("INCORRECT VALUE OF XAA1(" &
642 INTEGER'IMAGE(J) & ") (5)");
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)");
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)");
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)");
668 FOR J IN XAT1'RANGE LOOP
670 IF I /= IDENT_INT(5) THEN
671 FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
672 INTEGER'IMAGE(J) & ").VALU (5)");
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");
690 PROC (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
694 FOR I IN DAT1'RANGE LOOP