WITH REPORT;
PROCEDURE C37208A IS
USE REPORT;
BEGIN
TEST ("C37208A","DISCRIMINANT CONSTRAINT CAN BE OMITTED " &
"FROM OBJECT DECLARATION, COMPONENT DECLARATION, SUBTYPE " &
"INDICATION OR FORMAL SUBPROGRAM PARAMETER, IF THE TYPE " &
"HAS DEFAULT DISCRIMINANTS");
DECLARE
TYPE REC1(DISC : INTEGER := 7) IS
RECORD
NULL;
END RECORD;
TYPE REC2 IS
RECORD
COMP : REC1;
END RECORD;
R : REC2;
U1,U2,U3 : REC1 := (DISC => 3);
C1,C2,C3 : REC1(3) := (DISC => 3);
ARR : ARRAY(INTEGER RANGE 1..10) OF REC1;
ARR2 : ARRAY (1..10) OF REC1(4);
PROCEDURE PROC(P_IN : IN REC1;
P_OUT : OUT REC1;
P_IN_OUT : IN OUT REC1;
CONSTR : IN BOOLEAN) IS
BEGIN
IF P_OUT'CONSTRAINED /= CONSTR
OR P_IN_OUT'CONSTRAINED /= CONSTR THEN
FAILED ("CONSTRAINED ATTRIBUTES DO NOT MATCH " &
"FOR ACTUAL AND FORMAL PARAMETERS");
END IF;
IF P_IN'CONSTRAINED /= IDENT_BOOL(TRUE) THEN
FAILED ("'CONSTRAINED IS FALSE FOR IN " &
"PARAMETER");
END IF;
IF NOT CONSTR THEN P_OUT := (DISC => IDENT_INT(0));
P_IN_OUT := (DISC => IDENT_INT(0));
ELSE
BEGIN
P_OUT := (DISC => IDENT_INT(0));
FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
"PARAMETER ILLEGALLY CHANGED - 1");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION - 1");
END;
BEGIN
P_IN_OUT := (DISC => IDENT_INT(0));
FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
"PARAMETER ILLEGALLY CHANGED - 2");
EXCEPTION
WHEN CONSTRAINT_ERROR => NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION - 2");
END;
END IF;
END PROC;
BEGIN
IF U1.DISC /= IDENT_INT(3) THEN
FAILED ("INITIAL DISCRIMINANT VALUE WRONG - U1");
END IF;
U1 := (DISC => IDENT_INT(5));
IF U1.DISC /= 5 THEN
FAILED ("ASSIGNMENT FAILED FOR OBJECT");
END IF;
IF R.COMP.DISC /= IDENT_INT(7) THEN
FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - R");
END IF;
R.COMP := (DISC => IDENT_INT(5));
IF R.COMP.DISC /= 5 THEN
FAILED ("ASSIGNMENT FAILED FOR RECORD COMPONENT");
END IF;
FOR I IN 1..10 LOOP
IF ARR(I).DISC /= IDENT_INT(7) THEN
FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - ARR");
END IF;
END LOOP;
ARR(3) := (DISC => IDENT_INT(5));
IF ARR(3).DISC /= 5 THEN
FAILED ("ASSIGNMENT FAILED FOR ARRAY COMPONENT");
END IF;
IF ARR /= (1..2|4..10 => (DISC => 7), 3 => (DISC => 5)) THEN
FAILED ("MODIFIED WRONG COMPONENTS");
END IF;
PROC(C1,C2,C3,IDENT_BOOL(TRUE));
PROC(U1,U2,U3,IDENT_BOOL(FALSE));
IF U2.DISC /= 0 OR U3.DISC /= 0 THEN
FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL PARAMETER " &
"FAILED TO CHANGE DISCRIMINANT");
END IF;
PROC(ARR(1), ARR(3), ARR(4), FALSE);
IF ARR(3).DISC /= 0 OR ARR(4).DISC /= 0 THEN
FAILED ("ARRAY COMPONENT ASSIGNMENTS DIDN'T CHANGE " &
"DISCRIMINANT OF COMPONENT");
END IF;
PROC (ARR2(2), ARR2(5), ARR2(10), TRUE);
END;
RESULT;
END C37208A;