Subversion Repositories openrisc

-- C74306A.ADA

--                             Grant of Unlimited Rights

--

--     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 

--     unlimited rights in the software and documentation contained herein.

--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 

--     this public release, the Government intends to confer upon all 

--     recipients unlimited rights  equal to those held by the Government.  

--     These rights include rights to use, duplicate, release or disclose the 

--     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 

--     to do so.

--

--                                    DISCLAIMER

--

--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR

--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 

--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE

--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 

--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A

--     PARTICULAR PURPOSE OF SAID MATERIAL.

--*

-- OBJECTIVE:

--     AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF

--     THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY

--     EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL

--     DECLARATION.

-- HISTORY:

--     BCB 03/14/88  CREATED ORIGINAL TEST.

WITH REPORT; USE REPORT;

PROCEDURE C74306A IS

     GENERIC

          TYPE GENERAL_PURPOSE IS LIMITED PRIVATE;

          Y : IN OUT GENERAL_PURPOSE;

     FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;

     FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS

     BEGIN

          IF EQUAL(3,3) THEN

               RETURN X;

          END IF;

          RETURN Y;

     END IDENT;

     PACKAGE P IS

          TYPE T IS PRIVATE;

          C : CONSTANT T;

     PRIVATE

          TYPE T IS RANGE 1 .. 100;

          TYPE A IS ARRAY(1..2) OF T;

          TYPE B IS ARRAY(INTEGER RANGE <>) OF T;

          TYPE D (DISC : T) IS RECORD

               NULL;

          END RECORD;

          C : CONSTANT T := 50;

          PARAM : T := 99;

          FUNCTION IDENT_T IS NEW IDENT (T, PARAM);

          FUNCTION F (X : T := C) RETURN T;

          SUBTYPE RAN IS T RANGE 1 .. C;

          SUBTYPE IND IS B(1..INTEGER(C));

          SUBTYPE DIS IS D (DISC => C);

          OBJ : T := C;

          CON : CONSTANT T := C;

          ARR : A := (5, C);

          PAR : T := IDENT_T (C);

          RANOBJ : T RANGE 1 .. C := C;

          INDOBJ : B(1..INTEGER(C));

          DIS_VAL : DIS;

          REN : T RENAMES C;

          GENERIC

               FOR_PAR : T := C;

          PACKAGE GENPACK IS

               VAL : T;

          END GENPACK;

          GENERIC

               IN_PAR : IN T;

          PACKAGE NEWPACK IS

               IN_VAL : T;

          END NEWPACK;

     END P;

     USE P;

     PACKAGE BODY P IS

          TYPE A1 IS ARRAY(1..2) OF T;

          TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T;

          TYPE D1 (DISC1 : T) IS RECORD

               NULL;

          END RECORD;

          SUBTYPE RAN1 IS T RANGE 1 .. C;

          SUBTYPE IND1 IS B1(1..INTEGER(C));

          SUBTYPE DIS1 IS D1 (DISC1 => C);

          OBJ1 : T := C;

          FUNCVAR : T;

          CON1 : CONSTANT T := C;

          ARR1 : A1 := (5, C);

          PAR1 : T := IDENT_T (C);

          RANOBJ1 : T RANGE 1 .. C := C;

          INDOBJ1 : B1(1..INTEGER(C));

          DIS_VAL1 : DIS1;

          REN1 : T RENAMES C;

          FUNCTION F (X : T := C) RETURN T IS

          BEGIN

               RETURN C;

          END F;

          PACKAGE BODY GENPACK IS

          BEGIN

               VAL := FOR_PAR;

          END GENPACK;

          PACKAGE BODY NEWPACK IS

          BEGIN

               IN_VAL := IN_PAR;

          END NEWPACK;

          PACKAGE PACK IS NEW GENPACK (FOR_PAR => C);

          PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C);

     BEGIN

          TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " &

                           "CONSTANT, THE VALUE OF THE CONSTANT MAY " &

                           "BE USED IN ANY EXPRESSION, PARTICULARLY " &

                           "EXPRESSIONS IN WHICH THE USE WOULD BE " &

                           "ILLEGAL BEFORE THE FULL DECLARATION");

          IF OBJ /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR OBJ");

          END IF;

          IF CON /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR CON");

          END IF;

          IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN

               FAILED ("IMPROPER VALUES FOR ARR");

          END IF;

          IF PAR /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR PAR");

          END IF;

          IF OBJ1 /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR OBJ1");

          END IF;

          IF CON1 /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR CON1");

          END IF;

          IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN

               FAILED ("IMPROPER VALUES FOR ARR1");

          END IF;

          IF PAR1 /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR PAR1");

          END IF;

          IF PACK.VAL /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR PACK.VAL");

          END IF;

          IF NPACK.IN_VAL /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL");

          END IF;

          IF RAN'LAST /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR RAN'LAST");

          END IF;

          IF RANOBJ /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR RANOBJ");

          END IF;

          IF IND'LAST /= IDENT_INT(50) THEN

               FAILED ("IMPROPER VALUE FOR IND'LAST");

          END IF;

          IF INDOBJ'LAST /= IDENT_INT(50) THEN

               FAILED ("IMPROPER VALUE FOR INDOBJ'LAST");

          END IF;

          IF DIS_VAL.DISC /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC");

          END IF;

          IF REN /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR REN");

          END IF;

          IF RAN1'LAST /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR RAN1'LAST");

          END IF;

          IF RANOBJ1 /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR RANOBJ1");

          END IF;

          IF IND1'LAST /= IDENT_INT(50) THEN

               FAILED ("IMPROPER VALUE FOR IND1'LAST");

          END IF;

          IF INDOBJ1'LAST /= IDENT_INT(50) THEN

               FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST");

          END IF;

          IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1");

          END IF;

          IF REN1 /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR REN1");

          END IF;

          FUNCVAR := F(C);

          IF FUNCVAR /= IDENT_T(50) THEN

               FAILED ("IMPROPER VALUE FOR FUNCVAR");

          END IF;

          RESULT;

     END P;

BEGIN

     DECLARE

          TYPE ARR IS ARRAY(1..2) OF T;

          VAL1 : T := C;

          VAL2 : ARR := (C, C);

          VAL3 : T RENAMES C;

     BEGIN

          NULL;

     END;

     NULL;

END C74306A;