WITH REPORT; USE REPORT;
PROCEDURE C95085B IS
SUBTYPE INT IS INTEGER RANGE 0..10;
TYPE REC (N : INT := 0) IS
RECORD
A : STRING (1..N);
END RECORD;
SUBTYPE SREC IS REC(N=>3);
BEGIN
TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
"PARAMETERS OF RECORD TYPES");
DECLARE
TASK TSK1 IS
ENTRY E (R : IN SREC);
END TSK1;
TASK BODY TSK1 IS
BEGIN
LOOP
BEGIN
SELECT
ACCEPT E (R : IN SREC) DO
FAILED ("EXCEPTION NOT RAISED ON " &
"CALL TO TSK1");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TSK1");
END;
END LOOP;
END TSK1;
BEGIN
BEGIN TSK1.E ((2,"AA"));
FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
END;
BEGIN TSK1.E ((IDENT_INT(2), "AA"));
FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
END;
DECLARE R : REC := (IDENT_INT(2), "AA");
BEGIN TSK1.E (R);
FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
END;
END;
DECLARE
R : REC := (IDENT_INT(2), "AA");
TASK TSK2 IS
ENTRY E (R : IN OUT SREC);
END TSK2;
TASK BODY TSK2 IS
BEGIN
SELECT
ACCEPT E (R : IN OUT SREC) DO
FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
"TSK2");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TSK2");
END TSK2;
BEGIN TSK2.E (R);
FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
END;
DECLARE
R : REC;
TASK TSK3 IS
ENTRY E (R : OUT SREC);
END TSK3;
TASK BODY TSK3 IS
BEGIN
SELECT
ACCEPT E (R : OUT SREC) DO
FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
"TSK3");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TSK3");
END TSK3;
BEGIN TSK3.E (R);
FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
END;
RESULT;
END C95085B;