-- C37107A.ADA
|
-- C37107A.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- CHECK THAT A DEFAULT DISCRIMINANT EXPRESSION NEED NOT BE STATIC AND
|
-- CHECK THAT A DEFAULT DISCRIMINANT EXPRESSION NEED NOT BE STATIC AND
|
-- IS EVALUATED ONLY WHEN NEEDED.
|
-- IS EVALUATED ONLY WHEN NEEDED.
|
|
|
-- R.WILLIAMS 8/25/86
|
-- R.WILLIAMS 8/25/86
|
-- GMT 6/29/87 ADDED INTEGER ARGUMENT TO THE FUNCTION F.
|
-- GMT 6/29/87 ADDED INTEGER ARGUMENT TO THE FUNCTION F.
|
|
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
PROCEDURE C37107A IS
|
PROCEDURE C37107A IS
|
|
|
FUNCTION F ( B : BOOLEAN;
|
FUNCTION F ( B : BOOLEAN;
|
I : INTEGER ) RETURN INTEGER IS
|
I : INTEGER ) RETURN INTEGER IS
|
BEGIN
|
BEGIN
|
IF NOT B THEN
|
IF NOT B THEN
|
FAILED ( "DEFAULT DISCRIMINANT EVALUATED " &
|
FAILED ( "DEFAULT DISCRIMINANT EVALUATED " &
|
"UNNECESSARILY - " &
|
"UNNECESSARILY - " &
|
INTEGER'IMAGE(I) );
|
INTEGER'IMAGE(I) );
|
END IF;
|
END IF;
|
|
|
RETURN IDENT_INT (1);
|
RETURN IDENT_INT (1);
|
END F;
|
END F;
|
|
|
BEGIN
|
BEGIN
|
TEST ( "C37107A", "CHECK THAT A DEFAULT DISCRIMINANT " &
|
TEST ( "C37107A", "CHECK THAT A DEFAULT DISCRIMINANT " &
|
"EXPRESSION NEED NOT BE STATIC AND IS " &
|
"EXPRESSION NEED NOT BE STATIC AND IS " &
|
"EVALUATED ONLY WHEN NEEDED" );
|
"EVALUATED ONLY WHEN NEEDED" );
|
|
|
DECLARE
|
DECLARE
|
TYPE REC1 ( D : INTEGER := F (TRUE,1) ) IS
|
TYPE REC1 ( D : INTEGER := F (TRUE,1) ) IS
|
RECORD
|
RECORD
|
NULL;
|
NULL;
|
END RECORD;
|
END RECORD;
|
|
|
R1 : REC1;
|
R1 : REC1;
|
|
|
TYPE REC2 ( D : INTEGER := F (FALSE,2) ) IS
|
TYPE REC2 ( D : INTEGER := F (FALSE,2) ) IS
|
RECORD
|
RECORD
|
NULL;
|
NULL;
|
END RECORD;
|
END RECORD;
|
|
|
R2 : REC2 (D => 0);
|
R2 : REC2 (D => 0);
|
|
|
BEGIN
|
BEGIN
|
IF R1.D /= 1 THEN
|
IF R1.D /= 1 THEN
|
FAILED ( "INCORRECT VALUE FOR R1.D" );
|
FAILED ( "INCORRECT VALUE FOR R1.D" );
|
END IF;
|
END IF;
|
|
|
IF R2.D /= 0 THEN
|
IF R2.D /= 0 THEN
|
FAILED ( "INCORRECT VALUE FOR R2.D" );
|
FAILED ( "INCORRECT VALUE FOR R2.D" );
|
END IF;
|
END IF;
|
END;
|
END;
|
|
|
DECLARE
|
DECLARE
|
|
|
PACKAGE PRIV IS
|
PACKAGE PRIV IS
|
TYPE REC3 ( D : INTEGER := F (TRUE,3) ) IS PRIVATE;
|
TYPE REC3 ( D : INTEGER := F (TRUE,3) ) IS PRIVATE;
|
TYPE REC4 ( D : INTEGER := F (FALSE,4) ) IS PRIVATE;
|
TYPE REC4 ( D : INTEGER := F (FALSE,4) ) IS PRIVATE;
|
|
|
PRIVATE
|
PRIVATE
|
TYPE REC3 ( D : INTEGER := F (TRUE,3) ) IS
|
TYPE REC3 ( D : INTEGER := F (TRUE,3) ) IS
|
RECORD
|
RECORD
|
NULL;
|
NULL;
|
END RECORD;
|
END RECORD;
|
|
|
TYPE REC4 ( D : INTEGER := F (FALSE,4) ) IS
|
TYPE REC4 ( D : INTEGER := F (FALSE,4) ) IS
|
RECORD
|
RECORD
|
NULL;
|
NULL;
|
END RECORD;
|
END RECORD;
|
END PRIV;
|
END PRIV;
|
|
|
USE PRIV;
|
USE PRIV;
|
|
|
BEGIN
|
BEGIN
|
DECLARE
|
DECLARE
|
R3 : REC3;
|
R3 : REC3;
|
R4 : REC4 (D => 0);
|
R4 : REC4 (D => 0);
|
|
|
BEGIN
|
BEGIN
|
IF R3.D /= 1 THEN
|
IF R3.D /= 1 THEN
|
FAILED ( "INCORRECT VALUE FOR R3.D" );
|
FAILED ( "INCORRECT VALUE FOR R3.D" );
|
END IF;
|
END IF;
|
|
|
IF R4.D /= 0 THEN
|
IF R4.D /= 0 THEN
|
FAILED ( "INCORRECT VALUE FOR R4.D" );
|
FAILED ( "INCORRECT VALUE FOR R4.D" );
|
END IF;
|
END IF;
|
END;
|
END;
|
|
|
END;
|
END;
|
|
|
DECLARE
|
DECLARE
|
|
|
PACKAGE LPRIV IS
|
PACKAGE LPRIV IS
|
TYPE REC5
|
TYPE REC5
|
( D : INTEGER := F (TRUE,5) ) IS LIMITED PRIVATE;
|
( D : INTEGER := F (TRUE,5) ) IS LIMITED PRIVATE;
|
TYPE REC6
|
TYPE REC6
|
( D : INTEGER := F (FALSE,6) ) IS LIMITED PRIVATE;
|
( D : INTEGER := F (FALSE,6) ) IS LIMITED PRIVATE;
|
|
|
PRIVATE
|
PRIVATE
|
TYPE REC5 ( D : INTEGER := F (TRUE,5) ) IS
|
TYPE REC5 ( D : INTEGER := F (TRUE,5) ) IS
|
RECORD
|
RECORD
|
NULL;
|
NULL;
|
END RECORD;
|
END RECORD;
|
|
|
TYPE REC6 ( D : INTEGER := F (FALSE,6) ) IS
|
TYPE REC6 ( D : INTEGER := F (FALSE,6) ) IS
|
RECORD
|
RECORD
|
NULL;
|
NULL;
|
END RECORD;
|
END RECORD;
|
END LPRIV;
|
END LPRIV;
|
|
|
USE LPRIV;
|
USE LPRIV;
|
|
|
BEGIN
|
BEGIN
|
DECLARE
|
DECLARE
|
R5 : REC5;
|
R5 : REC5;
|
R6 : REC6 (D => 0);
|
R6 : REC6 (D => 0);
|
|
|
BEGIN
|
BEGIN
|
IF R5.D /= 1 THEN
|
IF R5.D /= 1 THEN
|
FAILED ( "INCORRECT VALUE FOR R5.D" );
|
FAILED ( "INCORRECT VALUE FOR R5.D" );
|
END IF;
|
END IF;
|
|
|
IF R6.D /= 0 THEN
|
IF R6.D /= 0 THEN
|
FAILED ( "INCORRECT VALUE FOR R6.D" );
|
FAILED ( "INCORRECT VALUE FOR R6.D" );
|
END IF;
|
END IF;
|
END;
|
END;
|
|
|
END;
|
END;
|
|
|
RESULT;
|
RESULT;
|
END C37107A;
|
END C37107A;
|
|
|