WITH REPORT; USE REPORT;
PROCEDURE C34018A IS
PACKAGE P IS
TYPE INT IS RANGE 1..100;
SUBTYPE INT_50 IS INT RANGE 1..50;
SUBTYPE INT_51 IS INT RANGE 51..100;
FUNCTION "+" (L, R : INT) RETURN INT;
FUNCTION G (X : INT_50) RETURN INT_51;
TYPE STR IS ARRAY (1..10) OF CHARACTER;
FUNCTION F (X : STR) RETURN STR;
END P;
USE P;
TYPE NEW_STR IS NEW P.STR;
TYPE NEW_INT IS NEW P.INT RANGE 51..90;
PACKAGE BODY P IS
FUNCTION "+" (L, R : INT) RETURN INT IS
BEGIN
RETURN INT(INTEGER(L) + INTEGER(R));
END "+";
FUNCTION G (X : INT_50) RETURN INT_51 IS
BEGIN
RETURN X + 10;
END G;
FUNCTION F (X : STR) RETURN STR IS
BEGIN
RETURN X;
END F;
END P;
BEGIN
TEST ("C34018A", "CHECK CONSTRAINTS PROCESSED CORRECTLY FOR " &
"CALLS OF DERIVED SUBPROGRAMS");
DECLARE
Y : NEW_STR := F("1234567890");
BEGIN
IF Y /= "1234567890" THEN
FAILED ("DERIVED F");
END IF;
END;
DECLARE
A : INT := 51;
B : NEW_INT := NEW_INT(IDENT_INT(90));
BEGIN
BEGIN
A := A + 0;
FAILED ("NO EXCEPTION - A + 0 = " & INT'IMAGE(A) ); EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION - 1");
END;
BEGIN
IF B + 2 /= 92 THEN FAILED ("WRONG RESULT - B + 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("WRONG CONSTRAINT FOR DERIVED ""+""");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION - 2");
END;
BEGIN
IF B + 14 > 90 THEN FAILED ("NO EXCEPTION RAISED FOR DERIVED ""+""");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION - 3");
END;
BEGIN
IF G(B) > 90 THEN FAILED ("NO EXCEPTION RAISED FOR DERIVED G");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION - 4");
END;
BEGIN
IF C34018A.G(41) /= 51 THEN FAILED ("WRONG RESULT - G(41)");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("C_E RAISED FOR LITERAL ARGUMENT");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION - 5");
END;
END;
RESULT;
END C34018A;