WITH REPORT; USE REPORT;
PROCEDURE C35508E IS
BEGIN
TEST( "C35508E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
"'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
"PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
"WHOSE ACTUAL ARGUMENT IS A BOOLEAN TYPE" );
DECLARE
TYPE NEWBOOL IS NEW BOOLEAN;
GENERIC
TYPE BOOL IS (<>);
PROCEDURE P (B : BOOL; STR : STRING );
PROCEDURE P (B : BOOL; STR : STRING) IS
SUBTYPE SUBBOOL IS BOOL
RANGE BOOL'VAL (IDENT_INT(0)) ..
BOOL'VAL (IDENT_INT(0));
BEGIN
IF BOOL'IMAGE (B) /= STR THEN
FAILED ( "INCORRECT BOOL'IMAGE OF " & STR );
END IF;
IF BOOL'IMAGE (B)'FIRST /= 1 THEN
FAILED ( "INCORRECT BOOL'FIRST FOR " & STR );
END IF;
IF SUBBOOL'IMAGE (B) /= STR THEN
FAILED ( "INCORRECT SUBBOOL'IMAGE OF " & STR );
END IF;
IF SUBBOOL'IMAGE (B)'FIRST /= 1 THEN
FAILED ( "INCORRECT SUBBOOL'FIRST FOR " & STR );
END IF;
END P;
PROCEDURE NP1 IS NEW P ( BOOLEAN );
PROCEDURE NP2 IS NEW P ( NEWBOOL );
BEGIN
NP1 ( TRUE, "TRUE" );
NP2 ( FALSE, "FALSE" );
END;
DECLARE
TYPE NEWBOOL IS NEW BOOLEAN;
GENERIC
TYPE BOOL IS (<>);
PROCEDURE P (STR : STRING; B : BOOL );
PROCEDURE P (STR : STRING; B : BOOL) IS
SUBTYPE SUBBOOL IS BOOL
RANGE BOOL'VAL (IDENT_INT(0)) ..
BOOL'VAL (IDENT_INT(0));
BEGIN
BEGIN
IF BOOL'VALUE (STR) /= B THEN
FAILED ( "INCORRECT BOOL'VALUE OF """ &
STR & """" );
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ( "EXCEPTION RAISED BOOL'VALUE OF """ &
STR & """" );
END;
BEGIN
IF SUBBOOL'VALUE (STR) /= B THEN
FAILED ( "INCORRECT SUBBOOL'VALUE OF """ &
STR & """" );
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ( "EXCEPTION RAISED SUBBOOL'VALUE " &
"OF """ & STR & """" );
END;
END P;
PROCEDURE NP1 IS NEW P ( BOOLEAN );
PROCEDURE NP2 IS NEW P ( NEWBOOL );
BEGIN
NP1 ( "TRUE", TRUE );
NP2 ( "FALSE", FALSE );
NP2 ( "true", TRUE );
NP1 ( "false", FALSE );
NP1 ( " TRUE", TRUE );
NP2 ( "FALSE ", FALSE );
END;
DECLARE
GENERIC
TYPE BOOL IS (<>);
PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING);
PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING) IS
SUBTYPE SUBBOOL IS BOOL
RANGE BOOL'VAL (IDENT_INT(0)) ..
BOOL'VAL (IDENT_INT(0));
BEGIN
BEGIN
IF BOOL'VALUE (STR1) = B THEN
FAILED ( "NO EXCEPTION RAISED - " &
"BOOL'VALUE WITH " & STR2 &
"- EQUAL " );
ELSE
FAILED ( "NO EXCEPTION RAISED - " &
"BOOL'VALUE WITH " & STR2 &
" - NOT EQUAL" );
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - " &
"BOOL'VALUE WITH " & STR2 );
END;
BEGIN
IF SUBBOOL'VALUE (STR1) /= B THEN
FAILED ( "NO EXCEPTION RAISED - " &
"SUBBOOL'VALUE WITH " &
STR2 & " - EQUAL");
ELSE
FAILED ( "NO EXCEPTION RAISED - " &
"SUBBOOL'VALUE WITH " &
STR2 & " - NOT EQUAL");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - " &
"SUBBOOL'VALUE WITH " & STR2 );
END;
END P;
PROCEDURE NP IS NEW P ( BOOLEAN );
BEGIN
NP ( "MAYBE", TRUE, "NON-BOOLEAN VALUE");
NP ( ASCII.HT & "TRUE", TRUE, "LEADING 'HT'" );
NP ( "FALSE" & ASCII.HT , FALSE, "TRAILING 'HT'" );
END;
RESULT;
END C35508E;