WITH REPORT; USE REPORT;
PROCEDURE C37213J IS
BEGIN
TEST ("C37213J", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
"OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
"DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
"RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
"USED AS THE ACTUAL PARAMETER TO A GENERIC " &
"FORMAL TYPE USED TO DECLARE AN OBJECT OR A " &
"SUBTYPE");
DECLARE
SUBTYPE SM IS INTEGER RANGE 1..10;
TYPE REC (D1, D2 : SM) IS
RECORD NULL; END RECORD;
TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
SEQUENCE_NUMBER : INTEGER;
GENERIC
TYPE CONS IS PRIVATE;
OBJ_XCP : BOOLEAN;
TAG : STRING;
PACKAGE OBJ_CHK IS END OBJ_CHK;
GENERIC
TYPE CONS IS PRIVATE;
PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
TAG : STRING);
PACKAGE BODY OBJ_CHK IS
BEGIN DECLARE
X : CONS;
FUNCTION VALUE RETURN CONS IS
BEGIN
IF EQUAL (3,3) THEN
RETURN X;
ELSE
RETURN X;
END IF;
END VALUE;
BEGIN
IF OBJ_XCP THEN
FAILED ("NO CHECK DURING DECLARATION " &
"OF OBJECT OF TYPE CONS - " & TAG);
ELSIF X /= VALUE THEN
FAILED ("INCORRECT VALUE FOR OBJECT OF " &
"TYPE CONS - " & TAG);
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
IF NOT OBJ_XCP THEN
FAILED ("IMPROPER CONSTRAINT CHECKED " &
"DURING DECLARATION OF OBJECT " &
"OF TYPE CONS - " & TAG);
END IF;
END OBJ_CHK;
PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
TAG : STRING) IS
BEGIN DECLARE
SUBTYPE SCONS IS CONS;
BEGIN
DECLARE
X : SCONS;
FUNCTION VALUE RETURN SCONS IS
BEGIN
IF EQUAL (5, 5) THEN
RETURN X;
ELSE
RETURN X;
END IF;
END VALUE;
BEGIN
IF OBJ_XCP THEN
FAILED ("NO CHECK DURING DECLARATION " &
"OF OBJECT OF SUBTYPE SCONS - " &
TAG);
ELSIF X /= VALUE THEN
FAILED ("INCORRECT VALUE FOR OBJECT " &
"OF SUBTYPE SCONS - " & TAG);
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
IF NOT OBJ_XCP THEN
FAILED ("IMPROPER CONSTRAINT CHECKED " &
"DURING DECLARATION OF OBJECT " &
"OF SUBTYPE SCONS - " & TAG);
END IF;
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
"DURING SUBTYPE DECLARATION - " & TAG);
END SUBTYP_CHK;
BEGIN
SEQUENCE_NUMBER := 1;
DECLARE
TYPE REC_DEF (D3 : INTEGER := 1) IS
RECORD
C1 : REC (D3, 0);
END RECORD;
PACKAGE PACK1 IS NEW OBJ_CHK (REC_DEF,
OBJ_XCP => TRUE,
TAG => "PACK1");
PROCEDURE PROC1 IS NEW SUBTYP_CHK (REC_DEF);
BEGIN
PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
END;
SEQUENCE_NUMBER := 2;
DECLARE
TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
RECORD
C1 : MY_ARR (0..D3);
END RECORD;
PACKAGE PACK2 IS NEW OBJ_CHK (ARR_DEF,
OBJ_XCP => TRUE,
TAG => "PACK2");
PROCEDURE PROC2 IS NEW SUBTYP_CHK (ARR_DEF);
BEGIN
PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
END;
SEQUENCE_NUMBER := 3;
DECLARE
TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : REC (D3, IDENT_INT(11));
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(5);
END CASE;
END RECORD;
PACKAGE PACK3 IS NEW OBJ_CHK (VAR_REC_DEF1,
OBJ_XCP => TRUE,
TAG => "PACK3");
PROCEDURE PROC3 IS NEW SUBTYP_CHK (VAR_REC_DEF1);
BEGIN
PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
END;
SEQUENCE_NUMBER := 4;
DECLARE
TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : REC (D3, IDENT_INT(11));
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(5);
END CASE;
END RECORD;
PACKAGE PACK4 IS NEW OBJ_CHK (VAR_REC_DEF6,
OBJ_XCP => FALSE,
TAG => "PACK4");
PROCEDURE PROC4 IS NEW SUBTYP_CHK (VAR_REC_DEF6);
BEGIN
PROC4 (OBJ_XCP => FALSE,TAG => "PROC4");
END;
SEQUENCE_NUMBER := 5;
DECLARE
TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : REC (D3, IDENT_INT(11));
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(5);
END CASE;
END RECORD;
PACKAGE PACK5 IS NEW OBJ_CHK (VAR_REC_DEF11,
OBJ_XCP => FALSE,
TAG => "PACK5");
PROCEDURE PROC5 IS NEW SUBTYP_CHK (VAR_REC_DEF11);
BEGIN
PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
END;
SEQUENCE_NUMBER := 6;
DECLARE
TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(D3..IDENT_INT(11));
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(5);
END CASE;
END RECORD;
PACKAGE PACK6 IS NEW OBJ_CHK (VAR_ARR_DEF1,
OBJ_XCP => TRUE,
TAG => "PACK6");
PROCEDURE PROC6 IS NEW SUBTYP_CHK (VAR_ARR_DEF1);
BEGIN
PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
END;
SEQUENCE_NUMBER := 7;
DECLARE
TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(D3..IDENT_INT(11));
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(5);
END CASE;
END RECORD;
PACKAGE PACK7 IS NEW OBJ_CHK (VAR_ARR_DEF6,
OBJ_XCP => FALSE,
TAG => "PACK7");
PROCEDURE PROC7 IS NEW SUBTYP_CHK (VAR_ARR_DEF6);
BEGIN
PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
END;
SEQUENCE_NUMBER := 8;
DECLARE
TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
RECORD
CASE D3 IS
WHEN -5..10 =>
C1 : MY_ARR(D3..IDENT_INT(11));
WHEN OTHERS =>
C2 : INTEGER := IDENT_INT(5);
END CASE;
END RECORD;
PACKAGE PACK8 IS NEW OBJ_CHK (VAR_ARR_DEF11,
OBJ_XCP => FALSE,
TAG => "PACK8");
PROCEDURE PROC8 IS NEW SUBTYP_CHK (VAR_ARR_DEF11);
BEGIN
PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED DURING DECLARATION / " &
"INSTANTIATION ELABORATION - " &
INTEGER'IMAGE(SEQUENCE_NUMBER));
END;
RESULT;
END C37213J;