WITH REPORT; USE REPORT;
PROCEDURE C37405A IS
TYPE REC(DISC : INTEGER := 25) IS
RECORD
COMP : INTEGER;
END RECORD;
SUBTYPE CONSTR IS REC(10);
SUBTYPE UNCONSTR IS REC;
TYPE REC_C IS
RECORD
COMP: CONSTR;
END RECORD;
TYPE REC_U IS
RECORD
COMP: UNCONSTR;
END RECORD;
C1,C2 : CONSTR;
U1,U2 : UNCONSTR;
ARR_C : ARRAY (1..5) OF CONSTR;
ARR_U : ARRAY (1..5) OF UNCONSTR;
REC_COMP_C : REC_C;
REC_COMP_U : REC_U;
PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
BEGIN
PARM := C2;
IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
"ASSIGNMENT - 1");
END IF;
END PROC11;
PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
BEGIN
PARM := U2;
IF B /= PARM'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
"ASSIGNMENT - 2");
END IF;
END PROC12;
PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
BEGIN
IF B /= PARM'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
"PASSING PARAMETER");
END IF;
PROC11(PARM, B);
PROC12(PARM, B);
END PROC1;
PROCEDURE PROC2(PARM : IN OUT CONSTR) IS
BEGIN
COMMENT ("CALLING PROC1 FROM PROC2"); PROC1(PARM,TRUE);
PARM := U2;
IF NOT PARM'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
"ASSIGNMENT - 3");
END IF;
END PROC2;
BEGIN
TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &
"PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");
C2 := (DISC => IDENT_INT(10), COMP => 3);
U2 := (DISC => IDENT_INT(10), COMP => 4);
ARR_C := (1..5 => U2);
ARR_U := (1..5 => C2);
REC_COMP_C := (COMP => U2);
REC_COMP_U := (COMP => C2);
C1 := U2;
U1 := C2;
IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");
END IF;
IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");
END IF;
IF REC_COMP_U.COMP'CONSTRAINED
OR NOT REC_COMP_C.COMP'CONSTRAINED THEN
FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");
END IF;
COMMENT("CALLING PROC1 DIRECTLY");
PROC1(C1,TRUE);
PROC2(C1);
COMMENT("CALLING PROC1 DIRECTLY");
PROC1(U1,FALSE);
PROC2(U1);
COMMENT("CALLING PROC1 DIRECTLY");
PROC1(ARR_C(4), TRUE);
PROC2(ARR_C(5));
COMMENT("CALLING PROC1 DIRECTLY");
PROC1(ARR_U(2), FALSE);
PROC2(ARR_U(3));
COMMENT("CALLING PROC1 DIRECTLY");
PROC1(REC_COMP_C.COMP, TRUE);
PROC2(REC_COMP_C.COMP);
COMMENT("CALLING PROC1 DIRECTLY");
PROC1(REC_COMP_U.COMP, FALSE);
PROC2(REC_COMP_U.COMP);
RESULT;
END C37405A;