WITH REPORT; USE REPORT;
PROCEDURE C37213H IS
BEGIN
TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &
"INDEX CONSTRAINT THAT DEPEND ON A " &
"DISCRIMINANT WITH A DEFAULT VALUE ARE " &
"PROPERLY EVALUATED AND CHECKED WHEN THE " &
"RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &
"THE COMPONENT IS AND IS NOT PRESENT IN THE " &
"SUBTYPE");
DECLARE
SEQUENCE_NUMBER : INTEGER;
SUBTYPE DISCR IS INTEGER RANGE -50..50;
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 & ": F1_CONS IS " &
INTEGER'IMAGE(F1_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
SEQUENCE_NUMBER :=1;
DECLARE
TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(F1..D3); WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(0);
END CASE;
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 ("VALUES NOT CORRECT");
END IF;
END;
F1_CONS := 12;
SEQUENCE_NUMBER := 2;
DECLARE
TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(D3..F1);
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(0);
END CASE;
END RECORD;
BEGIN
BEGIN
DECLARE
X : CONS;
BEGIN
FAILED ("INDEX CHECK NOT PERFORMED - 1");
IF X /= (1, (1, 1)) THEN
COMMENT ("INCORRECT VALUES FOR X - 1");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
END;
BEGIN
DECLARE
SUBTYPE SCONS IS CONS;
BEGIN
DECLARE
X : SCONS;
BEGIN
FAILED ("INDEX CHECK NOT PERFORMED - 2");
IF X /= (1, (1, 1)) THEN
COMMENT ("INCORRECT VALUES FOR X " &
"- 2");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED " &
"- 2A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
END;
BEGIN
DECLARE
TYPE ARR IS ARRAY (1..5) OF CONS;
BEGIN
DECLARE
X : ARR;
BEGIN
FAILED ("INDEX CHECK NOT PERFORMED - 3");
IF X /= (1..5 => (1, (1, 1))) THEN
COMMENT ("INCORRECT VALUES FOR X " &
"- 3");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED " &
"- 3A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
END;
BEGIN
DECLARE
TYPE NREC IS
RECORD
C1 : CONS;
END RECORD;
BEGIN
DECLARE
X : NREC;
BEGIN
FAILED ("INDEX CHECK NOT PERFORMED - 4");
IF X /= (C1 => (1, (1, 1))) THEN
COMMENT ("INCORRECT VALUES FOR X " &
"- 4");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED " &
"- 4A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
END;
BEGIN
DECLARE
TYPE NREC IS NEW CONS;
BEGIN
DECLARE
X : NREC;
BEGIN
FAILED ("INDEX CHECK NOT PERFORMED - 5");
IF X /= (1, (1, 1)) THEN
COMMENT ("INCORRECT VALUES FOR X " &
"- 5");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED " &
"- 5A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
END;
BEGIN
DECLARE
TYPE ACC_CONS IS ACCESS CONS;
BEGIN
DECLARE
X : ACC_CONS;
BEGIN
X := NEW CONS;
FAILED ("INDEX CHECK NOT PERFORMED - 6");
IF X.ALL /= (1, (1, 1)) THEN
COMMENT ("INCORRECT VALUES FOR X " &
"- 6");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
COMMENT ("UNEXPECTED EXCEPTION " &
"RAISED - 6A");
END;
EXCEPTION
WHEN OTHERS =>
COMMENT ("UNEXPECTED EXCEPTION RAISED " &
"- 6B");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
END;
END;
F1_CONS := 2;
SEQUENCE_NUMBER := 3;
DECLARE
TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(D3..F1); WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(0);
END CASE;
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 /= (-6, 0) OR Y /= (-6, 0) THEN
FAILED ("VALUES NOT CORRECT");
END IF;
END;
F1_CONS := 12;
SEQUENCE_NUMBER := 4;
DECLARE
TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(D3..F1);
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(0);
END CASE;
END RECORD;
BEGIN
BEGIN
DECLARE
X : CONS;
BEGIN
IF X /= (11, 0) THEN
FAILED ("X VALUE IS INCORRECT - 11");
END IF;
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
END;
BEGIN
DECLARE
SUBTYPE SCONS IS CONS;
BEGIN
DECLARE
X : SCONS;
BEGIN
IF X /= (11, 0) THEN
FAILED ("X VALUE INCORRECT - 12");
END IF;
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - " &
"12A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
END;
BEGIN
DECLARE
TYPE ARR IS ARRAY (1..5) OF CONS;
BEGIN
DECLARE
X : ARR;
BEGIN
IF X /= (1..5 => (11, 0)) THEN
FAILED ("X VALUE INCORRECT - 13");
END IF;
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - " &
"13A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
END;
BEGIN
DECLARE
TYPE NREC IS
RECORD
C1 : CONS;
END RECORD;
BEGIN
DECLARE
X : NREC;
BEGIN
IF X /= (C1 => (11, 0)) THEN
FAILED ("X VALUE INCORRECT - 14");
END IF;
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - " &
"14A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
END;
BEGIN
DECLARE
TYPE NREC IS NEW CONS;
BEGIN
DECLARE
X : NREC;
BEGIN
IF X /= (11, 0) THEN
FAILED ("X VALUE INCORRECT - 15");
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - " &
"15A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
END;
BEGIN
DECLARE
TYPE ACC_CONS IS ACCESS CONS;
X : ACC_CONS;
BEGIN
X := NEW CONS;
IF X.ALL /= (11, 0) THEN
FAILED ("X VALUE INCORRECT - 17");
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - " &
"17A");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
END;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
INTEGER'IMAGE (SEQUENCE_NUMBER));
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED " &
INTEGER'IMAGE (SEQUENCE_NUMBER));
END;
RESULT;
END C37213H;