WITH REPORT; USE REPORT;
PROCEDURE C47005A IS
BEGIN
TEST( "C47005A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
"DENOTES A FLOATING POINT TYPE, CHECK THAT " &
"CONSTRAINT_ERROR IS RAISED WHEN THE VALUE " &
"OF THE OPERAND DOES NOT LIE WITHIN THE " &
"RANGE OF THE TYPE MARK" );
DECLARE
SUBTYPE SFLOAT IS FLOAT RANGE -1.0 .. 1.0;
FUNCTION IDENT (F : FLOAT) RETURN FLOAT IS
BEGIN
IF EQUAL (3, 3) THEN
RETURN F;
ELSE
RETURN 0.0;
END IF;
END IDENT;
BEGIN
IF SFLOAT'(IDENT (-2.0)) = -1.0 THEN
FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
"SUBTYPE SFLOAT - 1");
ELSE
FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
"SUBTYPE SFLOAT - 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
"OF SUBTYPE SFLOAT" );
END;
DECLARE
TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
SUBTYPE SFLT IS FLT RANGE -1.0 .. 1.0;
FUNCTION IDENT (F : FLT) RETURN FLT IS
BEGIN
IF EQUAL (3, 3) THEN
RETURN F;
ELSE
RETURN 0.0;
END IF;
END IDENT;
BEGIN
IF SFLT'(IDENT (-2.0)) = -1.0 THEN
FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
"SUBTYPE SFLT - 1");
ELSE
FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
"SUBTYPE SFLT - 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
"OF SUBTYPE SFLT" );
END;
DECLARE
TYPE NFLT IS NEW FLOAT;
SUBTYPE SNFLT IS NFLT RANGE -1.0 .. 1.0;
FUNCTION IDENT (F : NFLT) RETURN NFLT IS
BEGIN
IF EQUAL (3, 3) THEN
RETURN F;
ELSE
RETURN 0.0;
END IF;
END IDENT;
BEGIN
IF SNFLT'(IDENT (2.0)) = 1.0 THEN
FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
"SUBTYPE SNFLT 1");
ELSE
FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
"SUBTYPE SNFLT 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
"OF SUBTYPE SNFLT" );
END;
RESULT;
END C47005A;