WITH REPORT; USE REPORT;
PROCEDURE C37006A IS
SUBTYPE INT IS INTEGER RANGE 0 .. 100;
TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
TYPE REC1 (D1, D2 : INT) IS
RECORD
A : ARR (D1 .. D2);
END RECORD;
TYPE REC1_NAME IS ACCESS REC1;
PROCEDURE CHECK (AR : ARR; STR : STRING) IS
BEGIN
IF AR'FIRST /= 1 OR AR'LAST /= 2 THEN
FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN COMPONENT " &
"OF " & STR & " TYPE");
ELSIF AR /= (3, 4) THEN
FAILED ( "INITIALIZATION OF R.COMP.A IN COMPONENT OF " &
STR & " TYPE FAILED" );
END IF;
END CHECK;
PACKAGE PACK IS
TYPE PRIV (D1, D2 : INT) IS PRIVATE;
TYPE LIM (D1, D2 : INT) IS LIMITED PRIVATE;
FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV;
PROCEDURE PRIV_CHECK (R : PRIV);
PROCEDURE LIM_CHECK (R : LIM);
PRIVATE
TYPE PRIV (D1, D2 : INT) IS
RECORD
A : ARR (D1 .. D2);
END RECORD;
TYPE LIM (D1, D2 : INT) IS
RECORD
A : ARR (D1 .. D2);
END RECORD;
END PACK;
PACKAGE BODY PACK IS
FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV IS
BEGIN
RETURN (IDENT_INT (1), IDENT_INT (2),
ARR'(1 => 3, 2 => 4));
END PRIV_FUN;
PROCEDURE PRIV_CHECK (R : PRIV) IS
BEGIN
CHECK (R.A, "PRIVATE TYPE" );
END PRIV_CHECK;
PROCEDURE LIM_CHECK (R : LIM) IS
BEGIN
IF R.A'FIRST /= 1 OR R.A'LAST /= 2 THEN
FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN " &
"COMPONENT OF LIMITED PRIVATE TYPE");
END IF;
END LIM_CHECK;
END PACK;
USE PACK;
BEGIN
TEST ( "C37006A", "FOR A COMPONENT OF A RECORD, ACCESS, " &
"OR PRIVATE TYPE, OR FOR A LIMITED PRIVATE " &
"COMPONENT, CHECK THAT A NON-STATIC " &
"EXPRESSION CAN BE USED IN A DISCRIMINANT " &
"CONSTRAINT OR (EXCEPTING LIMITED PRIVATE " &
"COMPONENTS) IN SPECIFYING A DEFAULT " &
"INITIAL VALUE" );
BEGIN
DECLARE
TYPE REC2 IS
RECORD
COMP : REC1 (IDENT_INT (1), IDENT_INT (2)) :=
(IDENT_INT (1), IDENT_INT (2),
ARR'(1 => 3, 2 => 4));
END RECORD;
R : REC2;
BEGIN
IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
CHECK (R.COMP.A, "RECORD");
ELSE
FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
"OF RECORD TYPE COMPONENT" );
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
"RECORD TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
"RECORD TYPE COMPONENT" );
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
"OF RECORD TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
"OF RECORD TYPE COMPONENT" );
END;
BEGIN
DECLARE
TYPE REC2 IS
RECORD
COMP : REC1_NAME (IDENT_INT (1),
IDENT_INT (2)) :=
NEW REC1'(IDENT_INT (1),
IDENT_INT (2),
ARR'(1 => 3, 2 => 4));
END RECORD;
R : REC2;
BEGIN
IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
CHECK (R.COMP.A, "ACCESS");
ELSE
FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
"OF ACCESS TYPE COMPONENT" );
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
"ACCESS TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
"ACCESS TYPE COMPONENT" );
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
"OF ACCESS TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
"OF ACCESS TYPE COMPONENT" );
END;
BEGIN
DECLARE
TYPE REC2 IS
RECORD
COMP : PRIV (IDENT_INT (1), IDENT_INT (2)) :=
PRIV_FUN (IDENT_INT (1),
IDENT_INT (2));
END RECORD;
R : REC2;
BEGIN
IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
PRIV_CHECK (R.COMP);
ELSE
FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
"OF PRIVATE TYPE COMPONENT" );
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
"PRIVATE TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
"PRIVATE TYPE COMPONENT" );
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
"OF PRIVATE TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
"OF PRIVATE TYPE COMPONENT" );
END;
BEGIN
DECLARE
TYPE REC2 IS
RECORD
COMP : LIM (IDENT_INT (1), IDENT_INT (2));
END RECORD;
R : REC2;
BEGIN
IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
LIM_CHECK (R.COMP);
ELSE
FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
"OF LIM PRIV TYPE COMPONENT" );
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
" LIM PRIV TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
"SEQUENCE FOLLOWING DECLARATION OF " &
" LIM PRIV TYPE COMPONENT" );
END;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
"OF LIM PRIV TYPE COMPONENT" );
WHEN OTHERS =>
FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
"OF LIM PRIV TYPE COMPONENT" );
END;
RESULT;
END C37006A;