Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/ada/acats/tests/c8/c85006b.ada @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/ada/acats/tests/c8/c85006b.ada Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,699 @@ +-- C85006B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY A +-- SUBPROGRAM 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE +-- CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT +-- STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' +-- OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, +-- AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED, +-- THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME. + +-- HISTORY: +-- JET 03/22/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE C85006B IS + + TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER; + TYPE RECORD1 (D : INTEGER) IS + RECORD + FIELD1 : INTEGER := 1; + END RECORD; + TYPE POINTER1 IS ACCESS INTEGER; + + PACKAGE PACK1 IS + TYPE PRIVY IS PRIVATE; + ZERO : CONSTANT PRIVY; + ONE : CONSTANT PRIVY; + TWO : CONSTANT PRIVY; + THREE : CONSTANT PRIVY; + FOUR : CONSTANT PRIVY; + FIVE : CONSTANT PRIVY; + FUNCTION IDENT (I : PRIVY) RETURN PRIVY; + FUNCTION NEXT (I : PRIVY) RETURN PRIVY; + PRIVATE + TYPE PRIVY IS RANGE 0..127; + ZERO : CONSTANT PRIVY := 0; + ONE : CONSTANT PRIVY := 1; + TWO : CONSTANT PRIVY := 2; + THREE : CONSTANT PRIVY := 3; + FOUR : CONSTANT PRIVY := 4; + FIVE : CONSTANT PRIVY := 5; + END PACK1; + + TASK TYPE TASK1 IS + ENTRY ASSIGN (J : IN INTEGER); + ENTRY VALU (J : OUT INTEGER); + ENTRY NEXT; + ENTRY STOP; + END TASK1; + + TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER; + TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3); + TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1); + TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1; + TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY; + TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1; + + TYPE REC_TYPE IS RECORD + RI1 : INTEGER := 0; + RA1 : ARRAY1(1..3) := (OTHERS => 0); + RR1 : RECORD1(1) := (D => 1, FIELD1 => 0); + RP1 : POINTER1 := NEW INTEGER'(0); + RV1 : PACK1.PRIVY := PACK1.ZERO; + RT1 : TASK1; + END RECORD; + + DREC : REC_TYPE; + + DAI1 : ARR_INT(1..8) := (OTHERS => 0); + DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0)); + DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0)); + DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0)); + DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO); + DAT1 : ARR_TSK(1..8); + + GENERIC + GRI1 : IN OUT INTEGER; + GRA1 : IN OUT ARRAY1; + GRR1 : IN OUT RECORD1; + GRP1 : IN OUT POINTER1; + GRV1 : IN OUT PACK1.PRIVY; + GRT1 : IN OUT TASK1; + GAI1 : IN OUT ARR_INT; + GAA1 : IN OUT ARR_ARR; + GAR1 : IN OUT ARR_REC; + GAP1 : IN OUT ARR_PTR; + GAV1 : IN OUT ARR_PVT; + GAT1 : IN OUT ARR_TSK; + PACKAGE GENERIC1 IS + END GENERIC1; + + FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS + BEGIN + IF EQUAL (3,3) THEN + RETURN P; + ELSE + RETURN NULL; + END IF; + END IDENT; + + PACKAGE BODY PACK1 IS + FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS + BEGIN + IF EQUAL(3,3) THEN + RETURN I; + ELSE + RETURN PRIVY'(0); + END IF; + END IDENT; + + FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS + BEGIN + RETURN I+1; + END NEXT; + END PACK1; + + PACKAGE BODY GENERIC1 IS + BEGIN + GRI1 := GRI1 + 1; + GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1); + GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1); + GRP1 := NEW INTEGER'(GRP1.ALL + 1); + GRV1 := PACK1.NEXT(GRV1); + GRT1.NEXT; + GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1); + GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1)); + GAR1 := (OTHERS => (D => 1, + FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1))); + GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1)); + FOR J IN GAV1'RANGE LOOP + GAV1(J) := PACK1.NEXT(GAV1(J)); + END LOOP; + FOR J IN GAT1'RANGE LOOP + GAT1(J).NEXT; + END LOOP; + END GENERIC1; + + TASK BODY TASK1 IS + TASK_VALUE : INTEGER := 0; + ACCEPTING_ENTRIES : BOOLEAN := TRUE; + BEGIN + WHILE ACCEPTING_ENTRIES LOOP + SELECT + ACCEPT ASSIGN (J : IN INTEGER) DO + TASK_VALUE := J; + END ASSIGN; + OR + ACCEPT VALU (J : OUT INTEGER) DO + J := TASK_VALUE; + END VALU; + OR + ACCEPT NEXT DO + TASK_VALUE := TASK_VALUE + 1; + END NEXT; + OR + ACCEPT STOP DO + ACCEPTING_ENTRIES := FALSE; + END STOP; + END SELECT; + END LOOP; + END TASK1; + + PROCEDURE PROC (REC : IN OUT REC_TYPE; + AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR; + AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR; + AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK) IS + + XRI1 : INTEGER RENAMES REC.RI1; + XRA1 : ARRAY1 RENAMES REC.RA1; + XRR1 : RECORD1 RENAMES REC.RR1; + XRP1 : POINTER1 RENAMES REC.RP1; + XRV1 : PACK1.PRIVY RENAMES REC.RV1; + XRT1 : TASK1 RENAMES REC.RT1; + XAI1 : ARR_INT RENAMES AI1(1..3); + XAA1 : ARR_ARR RENAMES AA1(2..4); + XAR1 : ARR_REC RENAMES AR1(3..5); + XAP1 : ARR_PTR RENAMES AP1(4..6); + XAV1 : ARR_PVT RENAMES AV1(5..7); + XAT1 : ARR_TSK RENAMES AT1(6..8); + + TASK TYPE TASK2 IS + ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1; + TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1; + TRV1 : IN OUT PACK1.PRIVY; + TRT1 : IN OUT TASK1; + TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR; + TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR; + TAV1 : IN OUT ARR_PVT; + TAT1 : IN OUT ARR_TSK); + END TASK2; + + I : INTEGER; + CHK_TASK : TASK2; + + TASK BODY TASK2 IS + BEGIN + ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1; + TRR1 : OUT RECORD1; + TRP1 : IN OUT POINTER1; + TRV1 : IN OUT PACK1.PRIVY; + TRT1: IN OUT TASK1; + TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR; + TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR; + TAV1 : IN OUT ARR_PVT; + TAT1 : IN OUT ARR_TSK) + DO + TRI1 := REC.RI1 + 1; + TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1); + TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1); + TRP1 := NEW INTEGER'(TRP1.ALL + 1); + TRV1 := PACK1.NEXT(TRV1); + TRT1.NEXT; + TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1); + TAA1 := (OTHERS => (OTHERS => + AA1(TAA1'FIRST)(1) + 1)); + TAR1 := (OTHERS => (D => 1, + FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1))); + TAP1 := (OTHERS => + NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1)); + FOR J IN TAV1'RANGE LOOP + TAV1(J) := PACK1.NEXT(TAV1(J)); + END LOOP; + FOR J IN TAT1'RANGE LOOP + TAT1(J).NEXT; + END LOOP; + END ENTRY1; + END TASK2; + + PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1; + PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1; + PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1; + PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR; + PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR; + PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS + BEGIN + PRI1 := PRI1 + 1; + PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1); + PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1); + PRP1 := NEW INTEGER'(REC.RP1.ALL + 1); + PRV1 := PACK1.NEXT(REC.RV1); + PRT1.NEXT; + PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1); + PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1)); + PAR1 := (OTHERS => (D => 1, FIELD1 => + (PAR1(PAR1'FIRST).FIELD1 + 1))); + PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL+1)); + FOR J IN PAV1'RANGE LOOP + PAV1(J) := PACK1.NEXT(AV1(J)); + END LOOP; + FOR J IN PAT1'RANGE LOOP + PAT1(J).NEXT; + END LOOP; + END PROC1; + + PACKAGE GENPACK1 IS NEW + GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1, + XAI1, XAA1, XAR1, XAP1, XAV1, XAT1); + + BEGIN + IF XRI1 /= IDENT_INT(1) THEN + FAILED ("INCORRECT VALUE OF XRI1 (1)"); + END IF; + + IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN + FAILED ("INCORRECT VALUE OF XRA1 (1)"); + END IF; + + IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN + FAILED ("INCORRECT VALUE OF XRR1 (1)"); + END IF; + + IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN + FAILED ("INCORRECT VALUE OF XRP1 (1)"); + END IF; + + IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN + FAILED ("INCORRECT VALUE OF XRV1 (1)"); + END IF; + + XRT1.VALU(I); + IF I /= IDENT_INT(1) THEN + FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)"); + END IF; + + FOR J IN XAI1'RANGE LOOP + IF XAI1(J) /= IDENT_INT(1) THEN + FAILED ("INCORRECT VALUE OF XAI1(" & + INTEGER'IMAGE(J) & ") (1)"); + END IF; + END LOOP; + + FOR J IN XAA1'RANGE LOOP + IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) + THEN + FAILED ("INCORRECT VALUE OF XAA1(" & + INTEGER'IMAGE(J) & ") (1)"); + END IF; + END LOOP; + + FOR J IN XAR1'RANGE LOOP + IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN + FAILED ("INCORRECT VALUE OF XAR1(" & + INTEGER'IMAGE(J) & ") (1)"); + END IF; + END LOOP; + + FOR J IN XAP1'RANGE LOOP + IF XAP1(J) /= IDENT(AP1(J)) OR + XAP1(J).ALL /= IDENT_INT(1) + THEN + FAILED ("INCORRECT VALUE OF XAP1(" & + INTEGER'IMAGE(J) & ") (1)"); + END IF; + END LOOP; + + FOR J IN XAV1'RANGE LOOP + IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN + FAILED ("INCORRECT VALUE OF XAV1(" & + INTEGER'IMAGE(J) & ") (1)"); + END IF; + END LOOP; + + FOR J IN XAT1'RANGE LOOP + XAT1(J).VALU(I); + IF I /= IDENT_INT(1) THEN + FAILED ("INCORRECT RETURN VALUE FROM XAT1(" & + INTEGER'IMAGE(J) & ").VALU (1)"); + END IF; + END LOOP; + + PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1, + XAI1, XAA1, XAR1, XAP1, XAV1, XAT1); + + IF XRI1 /= IDENT_INT(2) THEN + FAILED ("INCORRECT VALUE OF XRI1 (2)"); + END IF; + + IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN + FAILED ("INCORRECT VALUE OF XRA1 (2)"); + END IF; + + IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN + FAILED ("INCORRECT VALUE OF XRR1 (2)"); + END IF; + + IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN + FAILED ("INCORRECT VALUE OF XRP1 (2)"); + END IF; + + IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN + FAILED ("INCORRECT VALUE OF XRV1 (2)"); + END IF; + + XRT1.VALU(I); + IF I /= IDENT_INT(2) THEN + FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)"); + END IF; + + FOR J IN XAI1'RANGE LOOP + IF XAI1(J) /= IDENT_INT(2) THEN + FAILED ("INCORRECT VALUE OF XAI1(" & + INTEGER'IMAGE(J) & ") (2)"); + END IF; + END LOOP; + + FOR J IN XAA1'RANGE LOOP + IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) + THEN + FAILED ("INCORRECT VALUE OF XAA1(" & + INTEGER'IMAGE(J) & ") (2)"); + END IF; + END LOOP; + + FOR J IN XAR1'RANGE LOOP + IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN + FAILED ("INCORRECT VALUE OF XAR1(" & + INTEGER'IMAGE(J) & ") (2)"); + END IF; + END LOOP; + + FOR J IN XAP1'RANGE LOOP + IF XAP1(J) /= IDENT(AP1(J)) OR + XAP1(J).ALL /= IDENT_INT(2) THEN + FAILED ("INCORRECT VALUE OF XAP1(" & + INTEGER'IMAGE(J) & ") (2)"); + END IF; + END LOOP; + + FOR J IN XAV1'RANGE LOOP + IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN + FAILED ("INCORRECT VALUE OF XAV1(" & + INTEGER'IMAGE(J) & ") (2)"); + END IF; + END LOOP; + + FOR J IN XAT1'RANGE LOOP + XAT1(J).VALU(I); + IF I /= IDENT_INT(2) THEN + FAILED ("INCORRECT RETURN VALUE FROM XAT1(" & + INTEGER'IMAGE(J) & ").VALU (2)"); + END IF; + END LOOP; + + CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1, + XAI1, XAA1, XAR1, XAP1, XAV1, XAT1); + + IF XRI1 /= IDENT_INT(3) THEN + FAILED ("INCORRECT VALUE OF XRI1 (3)"); + END IF; + + IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN + FAILED ("INCORRECT VALUE OF XRA1 (3)"); + END IF; + + IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN + FAILED ("INCORRECT VALUE OF XRR1 (3)"); + END IF; + + IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN + FAILED ("INCORRECT VALUE OF XRP1 (3)"); + END IF; + + IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN + FAILED ("INCORRECT VALUE OF XRV1 (3)"); + END IF; + + XRT1.VALU(I); + IF I /= IDENT_INT(3) THEN + FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)"); + END IF; + + FOR J IN XAI1'RANGE LOOP + IF XAI1(J) /= IDENT_INT(3) THEN + FAILED ("INCORRECT VALUE OF XAI1(" & + INTEGER'IMAGE(J) & ") (3)"); + END IF; + END LOOP; + + FOR J IN XAA1'RANGE LOOP + IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) + THEN + FAILED ("INCORRECT VALUE OF XAA1(" & + INTEGER'IMAGE(J) & ") (3)"); + END IF; + END LOOP; + + FOR J IN XAR1'RANGE LOOP + IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN + FAILED ("INCORRECT VALUE OF XAR1(" & + INTEGER'IMAGE(J) & ") (3)"); + END IF; + END LOOP; + + FOR J IN XAP1'RANGE LOOP + IF XAP1(J) /= IDENT(AP1(J)) OR + XAP1(J).ALL /= IDENT_INT(3) THEN + FAILED ("INCORRECT VALUE OF XAP1(" & + INTEGER'IMAGE(J) & ") (3)"); + END IF; + END LOOP; + + FOR J IN XAV1'RANGE LOOP + IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN + FAILED ("INCORRECT VALUE OF XAV1(" & + INTEGER'IMAGE(J) & ") (3)"); + END IF; + END LOOP; + + FOR J IN XAT1'RANGE LOOP + XAT1(J).VALU(I); + IF I /= IDENT_INT(3) THEN + FAILED ("INCORRECT RETURN VALUE FROM XAT1(" & + INTEGER'IMAGE(J) & ").VALU (3)"); + END IF; + END LOOP; + + XRI1 := XRI1 + 1; + XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1); + XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1); + XRP1 := NEW INTEGER'(XRP1.ALL + 1); + XRV1 := PACK1.NEXT(XRV1); + XRT1.NEXT; + XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1); + XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1)); + XAR1 := (OTHERS => (D => 1, + FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1))); + XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1)); + FOR J IN XAV1'RANGE LOOP + XAV1(J) := PACK1.NEXT(XAV1(J)); + END LOOP; + FOR J IN XAT1'RANGE LOOP + XAT1(J).NEXT; + END LOOP; + + IF XRI1 /= IDENT_INT(4) THEN + FAILED ("INCORRECT VALUE OF XRI1 (4)"); + END IF; + + IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN + FAILED ("INCORRECT VALUE OF XRA1 (4)"); + END IF; + + IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN + FAILED ("INCORRECT VALUE OF XRR1 (4)"); + END IF; + + IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN + FAILED ("INCORRECT VALUE OF XRP1 (4)"); + END IF; + + IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN + FAILED ("INCORRECT VALUE OF XRV1 (4)"); + END IF; + + XRT1.VALU(I); + IF I /= IDENT_INT(4) THEN + FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)"); + END IF; + + FOR J IN XAI1'RANGE LOOP + IF XAI1(J) /= IDENT_INT(4) THEN + FAILED ("INCORRECT VALUE OF XAI1(" & + INTEGER'IMAGE(J) & ") (4)"); + END IF; + END LOOP; + + FOR J IN XAA1'RANGE LOOP + IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) + THEN + FAILED ("INCORRECT VALUE OF XAA1(" & + INTEGER'IMAGE(J) & ") (4)"); + END IF; + END LOOP; + + FOR J IN XAR1'RANGE LOOP + IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN + FAILED ("INCORRECT VALUE OF XAR1(" & + INTEGER'IMAGE(J) & ") (4)"); + END IF; + END LOOP; + + FOR J IN XAP1'RANGE LOOP + IF XAP1(J) /= IDENT(AP1(J)) OR + XAP1(J).ALL /= IDENT_INT(4) THEN + FAILED ("INCORRECT VALUE OF XAP1(" & + INTEGER'IMAGE(J) & ") (4)"); + END IF; + END LOOP; + + FOR J IN XAV1'RANGE LOOP + IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN + FAILED ("INCORRECT VALUE OF XAV1(" & + INTEGER'IMAGE(J) & ") (4)"); + END IF; + END LOOP; + + FOR J IN XAT1'RANGE LOOP + XAT1(J).VALU(I); + IF I /= IDENT_INT(4) THEN + FAILED ("INCORRECT RETURN VALUE FROM XAT1(" & + INTEGER'IMAGE(J) & ").VALU (4)"); + END IF; + END LOOP; + + REC.RI1 := REC.RI1 + 1; + REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1); + REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1); + REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1); + REC.RV1 := PACK1.NEXT(REC.RV1); + REC.RT1.NEXT; + AI1 := (OTHERS => AI1(XAI1'FIRST) + 1); + AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1)); + AR1 := (OTHERS => (D => 1, + FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1))); + AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1)); + FOR J IN XAV1'RANGE LOOP + AV1(J) := PACK1.NEXT(AV1(J)); + END LOOP; + FOR J IN XAT1'RANGE LOOP + AT1(J).NEXT; + END LOOP; + + IF XRI1 /= IDENT_INT(5) THEN + FAILED ("INCORRECT VALUE OF XRI1 (5)"); + END IF; + + IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN + FAILED ("INCORRECT VALUE OF XRA1 (5)"); + END IF; + + IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN + FAILED ("INCORRECT VALUE OF XRR1 (5)"); + END IF; + + IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN + FAILED ("INCORRECT VALUE OF XRP1 (5)"); + END IF; + + IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN + FAILED ("INCORRECT VALUE OF XRV1 (5)"); + END IF; + + XRT1.VALU(I); + IF I /= IDENT_INT(5) THEN + FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)"); + END IF; + + FOR J IN XAI1'RANGE LOOP + IF XAI1(J) /= IDENT_INT(5) THEN + FAILED ("INCORRECT VALUE OF XAI1(" & + INTEGER'IMAGE(J) & ") (5)"); + END IF; + END LOOP; + + FOR J IN XAA1'RANGE LOOP + IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) + THEN + FAILED ("INCORRECT VALUE OF XAA1(" & + INTEGER'IMAGE(J) & ") (5)"); + END IF; + END LOOP; + + FOR J IN XAR1'RANGE LOOP + IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN + FAILED ("INCORRECT VALUE OF XAR1(" & + INTEGER'IMAGE(J) & ") (5)"); + END IF; + END LOOP; + + FOR J IN XAP1'RANGE LOOP + IF XAP1(J) /= IDENT(AP1(J)) OR + XAP1(J).ALL /= IDENT_INT(5) THEN + FAILED ("INCORRECT VALUE OF XAP1(" & + INTEGER'IMAGE(J) & ") (5)"); + END IF; + END LOOP; + + FOR J IN XAV1'RANGE LOOP + IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN + FAILED ("INCORRECT VALUE OF XAV1(" & + INTEGER'IMAGE(J) & ") (5)"); + END IF; + END LOOP; + + FOR J IN XAT1'RANGE LOOP + XAT1(J).VALU(I); + IF I /= IDENT_INT(5) THEN + FAILED ("INCORRECT RETURN VALUE FROM XAT1(" & + INTEGER'IMAGE(J) & ").VALU (5)"); + END IF; + END LOOP; + + END PROC; + +BEGIN + TEST ("C85006B", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " & + "CREATED BY A SUBPROGRAM 'IN OUT' FORMAL " & + "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " & + "VALUE, AND THAT THE NEW NAME CAN BE USED IN " & + "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " & + "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " & + "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " & + "PARAMETER, AND THAT WHEN THE VALUE OF THE " & + "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " & + "REFLECTED BY THE VALUE OF THE NEW NAME"); + + PROC (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1); + + DREC.RT1.STOP; + + FOR I IN DAT1'RANGE LOOP + DAT1(I).STOP; + END LOOP; + + RESULT; +END C85006B;