WITH REPORT;
PROCEDURE C64104C IS
USE REPORT;
BEGIN
TEST ("C64104C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
"ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
DECLARE SUBTYPE ST IS STRING (1..3);
PROCEDURE P (A : ST) IS
BEGIN
FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
END P;
BEGIN
P ("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;
PROCEDURE P (A : T) IS
BEGIN
FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
END P;
BEGIN
P ((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));
PROCEDURE P (A :ST) IS
BEGIN
FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
END P;
BEGIN
P (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)));
PROCEDURE P (A : IN OUT ST) IS
BEGIN
FAILED ("EXCEPTION NOT RAISED ON CALLL - (D)");
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
END P;
BEGIN
P (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 => ' '));
PROCEDURE P (A : IN OUT ST) IS
BEGIN
COMMENT ("OK CASE CALLED CORRECTLY");
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
END P;
BEGIN
P (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 C64104C;