WITH SYSTEM; USE SYSTEM;
WITH REPORT; USE REPORT;
PROCEDURE C41402A IS
TYPE ARRAY1 IS ARRAY (1 .. 2) OF INTEGER;
TYPE ACC_ARA IS ACCESS ARRAY1;
PTR_ARA : ACC_ARA;
VAR1 : INTEGER;
TYPE REC1 IS
RECORD
A : INTEGER;
END RECORD;
TYPE ACC_REC1 IS ACCESS REC1;
TYPE REC2 IS
RECORD
P_AR : ACC_ARA;
P_REC : ACC_REC1;
END RECORD;
OBJ_REC : REC2;
PROCEDURE PROC (A : ADDRESS) IS
BEGIN
NULL;
END;
BEGIN
TEST ("C41402A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
"THE PREFIX OF 'ADDRESS, 'SIZE, " &
"'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE " &
"VALUE NULL");
BEGIN
PROC (PTR_ARA'ADDRESS);
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT_ERROR RAISED FOR 'ADDRESS");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED 'ADDRESS");
END;
BEGIN
VAR1 := PTR_ARA'SIZE;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT_ERROR RAISED FOR 'SIZE");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED 'SIZE");
END;
BEGIN
VAR1 := OBJ_REC.P_AR'FIRST_BIT;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT_ERROR RAISED FOR 'FIRST_BIT");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED 'FIRST_BIT");
END;
BEGIN
VAR1 := OBJ_REC.P_AR'LAST_BIT;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT_ERROR RAISED FOR 'LAST_BIT");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED 'LAST_BIT");
END;
BEGIN
VAR1 := OBJ_REC.P_REC'POSITION;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT_ERROR RAISED FOR 'POSITION");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED 'POSITION");
END;
RESULT;
END C41402A;