URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85006d.ada] - Rev 294
Compare with Previous | Blame | View Log
-- 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;