WITH REPORT; USE REPORT;
PROCEDURE C64104A IS
SUBTYPE DIGIT IS INTEGER RANGE 0..9;
CALLED : BOOLEAN;
D : DIGIT;
I : INTEGER;
M1 : CONSTANT INTEGER := IDENT_INT(-1);
COUNT : INTEGER := 0;
SUBTYPE SI IS INTEGER RANGE M1 .. 10;
PROCEDURE P1 (PIN : IN DIGIT; WHO : STRING) IS BEGIN
FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P1 " & WHO);
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN P1 FOR " & WHO);
END P1;
PROCEDURE P2 (PINOUT : IN OUT DIGIT; WHO : STRING) IS BEGIN
FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P2 " & WHO);
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN P2 FOR " & WHO);
END P2;
PROCEDURE P3 (POUT : OUT SI; WHO : STRING) IS BEGIN
IF WHO = "10" THEN
POUT := IDENT_INT(10); ELSE
POUT := -1;
END IF;
CALLED := TRUE;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN P3 FOR " & WHO);
END P3;
PROCEDURE P4 (PINOUT : IN OUT INTEGER; WHO : STRING) IS BEGIN
IF WHO = "10" THEN
PINOUT := 10; ELSE
PINOUT := IDENT_INT(-1);
END IF;
CALLED := TRUE;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN P4 FOR" & WHO);
END P4;
BEGIN
TEST ("C64104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
"FOR OUT OF RANGE SCALAR ARGUMENTS");
BEGIN P1 (10, "10");
FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (10)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P1 (10)");
END;
BEGIN P1 (IDENT_INT (-1), "-1");
FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (" &
"IDENT_INT (-1))");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P1 (" &
"IDENT_INT (-1))");
END;
BEGIN I := IDENT_INT (10);
P2 (I, "10");
FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (10)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P2 (10)");
END;
BEGIN I := IDENT_INT (-1);
P2 (I, "-1");
FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (-1)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P2 (-1)");
END;
BEGIN CALLED := FALSE;
D := IDENT_INT (1);
P3 (D, "10");
FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
" P3 (10)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
IF NOT CALLED THEN
FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P3 (10)");
END;
BEGIN CALLED := FALSE;
D := IDENT_INT (1);
P3 (D, "-1");
FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
" P3 (-1)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
IF NOT CALLED THEN
FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P3 (-1)");
END;
BEGIN CALLED := FALSE;
D := 9;
P4 (D, "10");
FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
" P4 (10)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
IF NOT CALLED THEN
FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P4 (10)");
END;
BEGIN CALLED := FALSE;
D := 0;
P4 (D, "-1");
FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
" P4 (-1)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
COUNT := COUNT + 1;
IF NOT CALLED THEN
FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED FOR P4 (-1)");
END;
IF (COUNT /= 8) THEN
FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
END IF;
RESULT;
END C64104A;