WITH REPORT; USE REPORT;
PROCEDURE C43004C IS
ZERO : INTEGER := 0;
TYPE REC (D : INTEGER := 0) IS RECORD
COMP1 : INTEGER;
END RECORD;
TYPE DREC (DD : INTEGER := ZERO) IS RECORD
DCOMP1 : INTEGER;
END RECORD;
TYPE REC1 IS RECORD
A : REC(0);
END RECORD;
TYPE REC2 IS RECORD
B : DREC(ZERO);
END RECORD;
TYPE REC3 (D3 : INTEGER := 0) IS RECORD
C : REC(D3);
END RECORD;
V : REC1;
W : REC2;
X : REC3;
PACKAGE P IS
TYPE PRIV1 (D : INTEGER := 0) IS PRIVATE;
TYPE PRIV2 (DD : INTEGER := ZERO) IS PRIVATE;
FUNCTION INIT (I : INTEGER) RETURN PRIV1;
PRIVATE
TYPE PRIV1 (D : INTEGER := 0) IS RECORD
NULL;
END RECORD;
TYPE PRIV2 (DD : INTEGER := ZERO) IS RECORD
NULL;
END RECORD;
END P;
TYPE REC7 IS RECORD
H : P.PRIV1 (0);
END RECORD;
Y : REC7;
GENERIC
TYPE GP IS PRIVATE;
FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN;
FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN IS
BEGIN
RETURN X = Y;
END GEN_EQUAL;
PACKAGE BODY P IS
TYPE REC4 IS RECORD
E : PRIV1(0);
END RECORD;
TYPE REC5 IS RECORD
F : PRIV2(ZERO);
END RECORD;
TYPE REC6 (D6 : INTEGER := 0) IS RECORD
G : PRIV1(D6);
END RECORD;
VV : REC4;
WW : REC5;
XX : REC6;
FUNCTION REC4_EQUAL IS NEW GEN_EQUAL (REC4);
FUNCTION REC5_EQUAL IS NEW GEN_EQUAL (REC5);
FUNCTION REC6_EQUAL IS NEW GEN_EQUAL (REC6);
FUNCTION INIT (I : INTEGER) RETURN PRIV1 IS
VAR : PRIV1;
BEGIN
VAR := (D => I);
RETURN VAR;
END INIT;
BEGIN
TEST ("C43004C", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
"IF THE VALUE OF A DISCRIMINANT OF A " &
"CONSTRAINED COMPONENT OF AN AGGREGATE " &
"DOES NOT EQUAL THE CORRESPONDING " &
"DISCRIMINANT VALUE FOR THECOMPONENT'S " &
"SUBTYPE");
BEGIN
VV := (E => (D => 1));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
IF REC4_EQUAL (VV,VV) THEN
COMMENT ("DON'T OPTIMIZE VV");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 1");
END;
BEGIN
WW := (F => (DD => 1));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
IF REC5_EQUAL (WW,WW) THEN
COMMENT ("DON'T OPTIMIZE WW");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 2");
END;
BEGIN
XX := (D6 => 1, G => (D => 5));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
IF REC6_EQUAL (XX,XX) THEN
COMMENT ("DON'T OPTIMIZE XX");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 3");
END;
END P;
USE P;
FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
FUNCTION REC2_EQUAL IS NEW GEN_EQUAL (REC2);
FUNCTION REC3_EQUAL IS NEW GEN_EQUAL (REC3);
FUNCTION REC7_EQUAL IS NEW GEN_EQUAL (REC7);
BEGIN
BEGIN
V := (A => (D => 1, COMP1 => 2));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
IF REC1_EQUAL (V,V) THEN
COMMENT ("DON'T OPTIMIZE V");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 4");
END;
BEGIN
W := (B => (DD => 1, DCOMP1 => 2));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 5");
IF REC2_EQUAL (W,W) THEN
COMMENT ("DON'T OPTIMIZE W");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 5");
END;
BEGIN
X := (D3 => 1, C => (D => 5, COMP1 => 2));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 6");
IF REC3_EQUAL (X,X) THEN
COMMENT ("DON'T OPTIMIZE X");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 6");
END;
BEGIN
Y := (H => INIT (1));
FAILED ("CONSTRAINT_ERROR NOT RAISED - 7");
IF REC7_EQUAL (Y,Y) THEN
COMMENT ("DON'T OPTIMIZE Y");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED - 7");
END;
RESULT;
END C43004C;