aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada712
1 files changed, 712 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada
new file mode 100644
index 000000000..b93640214
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada
@@ -0,0 +1,712 @@
+-- C85006D.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
+-- GENERIC '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 C85006D 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
+ 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;
+ 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
+ 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;
+
+ CHK_TASK : TASK2;
+ I : INTEGER;
+
+ 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 GENERIC2 IS
+ END GENERIC2;
+
+ PACKAGE BODY GENERIC2 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 GENERIC2;
+
+ 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;
+
+ 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;
+
+ PACKAGE GENPACK2 IS NEW
+ GENERIC2 (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 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;
+
+BEGIN
+ TEST ("C85006D", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+ "CREATED BY A GENERIC '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");
+
+ DECLARE
+ PACKAGE GENPACK IS NEW
+ GENERIC1 (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+ BEGIN
+ NULL;
+ END;
+
+ DREC.RT1.STOP;
+
+ FOR I IN DAT1'RANGE LOOP
+ DAT1(I).STOP;
+ END LOOP;
+
+ RESULT;
+END C85006D;