WITH REPORT; USE REPORT;
PROCEDURE C95086D IS
BEGIN
TEST ("C95086D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
"BEFORE AND AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED " &
"ACTUAL OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR " &
"TO THE ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE " &
"FORMAL PARAMETER");
DECLARE
PACKAGE PKG IS
SUBTYPE INT IS INTEGER RANGE 0..5;
TYPE T (I : INT := 0) IS LIMITED PRIVATE;
PRIVATE
TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
TYPE T (I : INT := 0) IS
RECORD
J : INTEGER;
A : ARR (1..I);
END RECORD;
END PKG;
USE PKG;
TYPE A IS ACCESS T;
SUBTYPE SA IS A (3);
V : A := NEW T (2);
CALLED : BOOLEAN := FALSE;
TASK T1 IS
ENTRY P (X : OUT SA);
END T1;
TASK BODY T1 IS
BEGIN
ACCEPT P (X : OUT SA) DO
CALLED := TRUE;
X := NEW T (3);
END P;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (A)");
END T1;
BEGIN
T1.P (V);
EXCEPTION
WHEN CONSTRAINT_ERROR =>
IF NOT CALLED THEN
FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (A)");
ELSE
FAILED ("EXCEPTION RAISED ON RETURN - (A)");
END IF;
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED - (A)");
END;
DECLARE
TYPE A IS ACCESS STRING;
SUBTYPE SA IS A (1..2);
V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
CALLED : BOOLEAN := FALSE;
TASK T1 IS
ENTRY P (X : OUT SA);
END T1;
TASK BODY T1 IS
BEGIN
ACCEPT P (X : OUT SA) DO
CALLED := TRUE;
X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
END P;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (B)");
END T1;
BEGIN
T1.P (V);
EXCEPTION
WHEN CONSTRAINT_ERROR =>
IF NOT CALLED THEN
FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (B)");
ELSE
FAILED ("EXCEPTION RAISED ON RETURN - (B)");
END IF;
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED - (B)");
END;
RESULT;
END C95086D;