WITH REPORT; USE REPORT;
PROCEDURE C95085C IS
BEGIN
TEST ("C95085C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
"ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
DECLARE SUBTYPE ST IS STRING (1..3);
TASK TSK IS
ENTRY E (A : ST);
END TSK;
TASK BODY TSK IS
BEGIN
SELECT
ACCEPT E (A : ST) DO
FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (A)");
END TSK;
BEGIN
TSK.E ("AB");
FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - (A)");
END;
DECLARE
SUBTYPE S IS INTEGER RANGE 1..3;
TYPE T IS ARRAY (S,S) OF INTEGER;
TASK TSK IS
ENTRY E (A : T);
END TSK;
TASK BODY TSK IS
BEGIN
SELECT
ACCEPT E (A : T) DO
FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (B)");
END TSK;
BEGIN
TSK.E ((1..3 => (1..IDENT_INT(2) => 0)));
FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - (B)");
END;
DECLARE
SUBTYPE S IS INTEGER RANGE 1..5;
TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
SUBTYPE ST IS T (1..3,1..3);
V : T (1..IDENT_INT(2), 1..3) :=
(1..IDENT_INT(2) => (1..3 => 0));
TASK TSK IS
ENTRY E (A :ST);
END TSK;
TASK BODY TSK IS
BEGIN
SELECT
ACCEPT E (A :ST) DO
FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (C)");
END TSK;
BEGIN
TSK.E (V);
FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - (C)");
END;
DECLARE
SUBTYPE S IS INTEGER RANGE 1..5;
TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
INTEGER;
SUBTYPE ST IS T (1..3, 1..3, 1..3);
V : T (1..3, 1..2, 1..3) :=
(1..3 => (1..2 => (1..3 => 0)));
TASK TSK IS
ENTRY E (A : IN OUT ST);
END TSK;
TASK BODY TSK IS
BEGIN
SELECT
ACCEPT E (A : IN OUT ST) DO
FAILED ("EXCEPTION NOT RAISED ON CALL - (D)");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (D)");
END TSK;
BEGIN
TSK.E (V);
FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - (D)");
END;
DECLARE
SUBTYPE S IS INTEGER RANGE 1..5;
TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
SUBTYPE ST IS T (2..1, 2..1);
V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
TASK TSK IS
ENTRY E (A : IN OUT ST);
END TSK;
TASK BODY TSK IS
BEGIN
SELECT
ACCEPT E (A : IN OUT ST) DO
COMMENT ("OK CASE CALLED CORRECTLY");
END E;
OR
TERMINATE;
END SELECT;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN TASK - (G)");
END TSK;
BEGIN
TSK.E (V);
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
WHEN OTHERS =>
FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
END;
RESULT;
END C95085C;