WITH REPORT;
PROCEDURE C48009J IS
USE REPORT;
BEGIN
TEST("C48009J","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
"THAT CONSTRAINT_ERROR IS RAISED WHEN " &
"APPROPRIATE - ACCESS TYPE OF UNCONSTRAINED " &
"ACCESS TYPE");
DECLARE
TYPE INT IS RANGE 1 .. 5;
TYPE UR(A : INT) IS
RECORD
NULL;
END RECORD;
TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
PACKAGE P IS
TYPE UP(A : INT) IS PRIVATE;
TYPE UL(A : INT) IS LIMITED PRIVATE;
PRIVATE
TYPE UP(A : INT) IS
RECORD
NULL;
END RECORD;
TYPE UL(A : INT) IS
RECORD
NULL;
END RECORD;
END P;
TYPE A_UR IS ACCESS UR;
TYPE A_UA IS ACCESS UA;
TYPE A_UP IS ACCESS P.UP;
TYPE A_UL IS ACCESS P.UL;
TYPE AA_UR IS ACCESS A_UR;
TYPE AA_UA IS ACCESS A_UA;
TYPE AA_UP IS ACCESS A_UP;
TYPE AA_UL IS ACCESS A_UL;
V_AA_UR : AA_UR;
V_AA_UA : AA_UA;
V_AA_UP : AA_UP;
V_AA_UL : AA_UL;
BEGIN
BEGIN
V_AA_UR := NEW A_UR'(NEW UR(INT(IDENT_INT(6))));
FAILED ("NO EXCEPTION RAISED - UR");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - UR");
END;
BEGIN
V_AA_UA := NEW A_UA'(NEW UA(4 .. 7));
FAILED ("NO EXCEPTION RAISED - UA");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - UA");
END;
BEGIN
V_AA_UP := NEW A_UP'(NEW P.UP(0));
FAILED ("NO EXCEPTION RAISED - UP");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - UP");
END;
BEGIN
V_AA_UL := NEW A_UL'(NEW P.UL(INT(IDENT_INT(0))));
FAILED ("NO EXCEPTION RAISED - UL");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - UL");
END;
END;
RESULT;
END C48009J;