WITH REPORT; USE REPORT;
PROCEDURE C37213D IS
SUBTYPE SM IS INTEGER RANGE 1..10;
TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
F1_CONS : INTEGER := 2;
FUNCTION CHK (
CONS : INTEGER;
VALUE : INTEGER;
MESSAGE : STRING) RETURN BOOLEAN IS
BEGIN
IF CONS /= VALUE THEN
FAILED (MESSAGE & ": CONS IS " &
INTEGER'IMAGE(CONS));
END IF;
RETURN TRUE;
END CHK;
FUNCTION F1 RETURN INTEGER IS
BEGIN
F1_CONS := F1_CONS - IDENT_INT(1);
RETURN F1_CONS;
END F1;
BEGIN
TEST ("C37213D", "CHECK EVALUATION OF INDEX BOUNDS " &
"WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
"AND DISCRIMINANTS HAVE DEFAULTS");
DECLARE
TYPE CONS (D3 : INTEGER := 1) IS
RECORD
C1 : MY_ARR (F1..D3); END RECORD;
CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
X : CONS; Y : CONS; CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
BEGIN
IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
FAILED ("INDEX BOUNDS NOT CORRECT");
END IF;
END;
F1_CONS := 12;
DECLARE
TYPE CONS (D3 : INTEGER := 1) IS
RECORD
C1 : MY_ARR(D3..F1);
END RECORD;
BEGIN
BEGIN
DECLARE
X : CONS;
BEGIN
FAILED ("INDEX CHECK NOT PERFORMED - 1");
IF X /= (1, (1, 1)) THEN
COMMENT ("SHOULDN'T GET HERE");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION - 1");
END;
BEGIN
DECLARE
TYPE ACC_CONS IS ACCESS CONS;
X : ACC_CONS;
BEGIN
X := NEW CONS;
FAILED ("INDEX CHECK NOT PERFORMED - 2");
BEGIN
IF X.ALL /= (1, (1 => 1)) THEN
COMMENT ("IRRELEVANT");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
END;
BEGIN
DECLARE
SUBTYPE SCONS IS CONS;
BEGIN
DECLARE
X : SCONS;
BEGIN
FAILED ("INDEX CHECK NOT " &
"PERFORMED - 3");
IF X /= (1, (1 => 1)) THEN
COMMENT ("IRRELEVANT");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
END;
BEGIN
DECLARE
TYPE ARR IS ARRAY (1..5) OF CONS;
BEGIN
DECLARE
X : ARR;
BEGIN
FAILED ("INDEX CHECK NOT " &
"PERFORMED - 4");
IF X /= (1..5 => (1, (1 => 1))) THEN
COMMENT ("IRRELEVANT");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
END;
BEGIN
DECLARE
TYPE NREC IS
RECORD
C1 : CONS;
END RECORD;
BEGIN
DECLARE
X : NREC;
BEGIN
FAILED ("INDEX CHECK NOT " &
"PERFORMED - 5");
IF X /= (C1 => (1, (1 => 1))) THEN
COMMENT ("IRRELEVANT");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
END;
BEGIN
DECLARE
TYPE DREC IS NEW CONS;
BEGIN
DECLARE
X : DREC;
BEGIN
FAILED ("INDEX CHECK NOT " &
"PERFORMED - 6");
IF X /= (1, (1 => 1)) THEN
COMMENT ("IRRELEVANT");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
END;
END;
RESULT;
EXCEPTION
WHEN OTHERS =>
FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
RESULT;
END C37213D;