WITH REPORT; USE REPORT;
PROCEDURE C37107A IS
FUNCTION F ( B : BOOLEAN;
I : INTEGER ) RETURN INTEGER IS
BEGIN
IF NOT B THEN
FAILED ( "DEFAULT DISCRIMINANT EVALUATED " &
"UNNECESSARILY - " &
INTEGER'IMAGE(I) );
END IF;
RETURN IDENT_INT (1);
END F;
BEGIN
TEST ( "C37107A", "CHECK THAT A DEFAULT DISCRIMINANT " &
"EXPRESSION NEED NOT BE STATIC AND IS " &
"EVALUATED ONLY WHEN NEEDED" );
DECLARE
TYPE REC1 ( D : INTEGER := F (TRUE,1) ) IS
RECORD
NULL;
END RECORD;
R1 : REC1;
TYPE REC2 ( D : INTEGER := F (FALSE,2) ) IS
RECORD
NULL;
END RECORD;
R2 : REC2 (D => 0);
BEGIN
IF R1.D /= 1 THEN
FAILED ( "INCORRECT VALUE FOR R1.D" );
END IF;
IF R2.D /= 0 THEN
FAILED ( "INCORRECT VALUE FOR R2.D" );
END IF;
END;
DECLARE
PACKAGE PRIV IS
TYPE REC3 ( D : INTEGER := F (TRUE,3) ) IS PRIVATE;
TYPE REC4 ( D : INTEGER := F (FALSE,4) ) IS PRIVATE;
PRIVATE
TYPE REC3 ( D : INTEGER := F (TRUE,3) ) IS
RECORD
NULL;
END RECORD;
TYPE REC4 ( D : INTEGER := F (FALSE,4) ) IS
RECORD
NULL;
END RECORD;
END PRIV;
USE PRIV;
BEGIN
DECLARE
R3 : REC3;
R4 : REC4 (D => 0);
BEGIN
IF R3.D /= 1 THEN
FAILED ( "INCORRECT VALUE FOR R3.D" );
END IF;
IF R4.D /= 0 THEN
FAILED ( "INCORRECT VALUE FOR R4.D" );
END IF;
END;
END;
DECLARE
PACKAGE LPRIV IS
TYPE REC5
( D : INTEGER := F (TRUE,5) ) IS LIMITED PRIVATE;
TYPE REC6
( D : INTEGER := F (FALSE,6) ) IS LIMITED PRIVATE;
PRIVATE
TYPE REC5 ( D : INTEGER := F (TRUE,5) ) IS
RECORD
NULL;
END RECORD;
TYPE REC6 ( D : INTEGER := F (FALSE,6) ) IS
RECORD
NULL;
END RECORD;
END LPRIV;
USE LPRIV;
BEGIN
DECLARE
R5 : REC5;
R6 : REC6 (D => 0);
BEGIN
IF R5.D /= 1 THEN
FAILED ( "INCORRECT VALUE FOR R5.D" );
END IF;
IF R6.D /= 0 THEN
FAILED ( "INCORRECT VALUE FOR R6.D" );
END IF;
END;
END;
RESULT;
END C37107A;