blob: 885d8393af33e58ccfab2ad5a8990b0627babd03 [file] [log] [blame]
-- 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;