Subversion Repositories openrisc

-- C74302B.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:

--     CHECK THAT WHEN THE FULL DECLARATION OF A DEFERRED CONSTANT IS

--     GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION

--     IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT.  (USE ENUMERATION,

--     INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING

--     USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE

--     TYPES AS FULL DECLARATION OF PRIVATE TYPE)

-- HISTORY:

--     BCB 07/25/88  CREATED ORIGINAL TEST.

WITH REPORT; USE REPORT;

PROCEDURE C74302B IS

     TYPE ARR_RAN IS RANGE 1..2;

     BUMP : INTEGER := IDENT_INT(0);

     GENERIC

          TYPE DT IS (<>);

     FUNCTION F1 RETURN DT;

     GENERIC

          TYPE FE IS DELTA <>;

     FUNCTION F2 RETURN FE;

     GENERIC

          TYPE FLE IS DIGITS <>;

     FUNCTION F3 RETURN FLE;

     GENERIC

          TYPE CA IS ARRAY(ARR_RAN) OF INTEGER;

     FUNCTION F4 RETURN CA;

     GENERIC

          TYPE GP IS LIMITED PRIVATE;

     FUNCTION F5 (V : GP) RETURN GP;

     GENERIC

          TYPE GP1 IS LIMITED PRIVATE;

     FUNCTION F6 (V1 : GP1) RETURN GP1;

     GENERIC

          TYPE AC IS ACCESS INTEGER;

     FUNCTION F7 RETURN AC;

     GENERIC

          TYPE PP IS PRIVATE;

     FUNCTION F8 (P1 : PP) RETURN PP;

     FUNCTION F1 RETURN DT IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN DT'VAL(BUMP);

     END F1;

     FUNCTION F2 RETURN FE IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN FE(BUMP);

     END F2;

     FUNCTION F3 RETURN FLE IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN FLE(BUMP);

     END F3;

     FUNCTION F4 RETURN CA IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN ((BUMP,BUMP-1));

     END F4;

     FUNCTION F5 (V : GP) RETURN GP IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN V;

     END F5;

     FUNCTION F6 (V1 : GP1) RETURN GP1 IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN V1;

     END F6;

     FUNCTION F7 RETURN AC IS

          VAR : AC;

     BEGIN

          BUMP := BUMP + 1;

          VAR := NEW INTEGER'(BUMP);

          RETURN VAR;

     END F7;

     FUNCTION F8 (P1 : PP) RETURN PP IS

     BEGIN

          BUMP := BUMP + 1;

          RETURN P1;

     END F8;

     PACKAGE PACK IS

          TYPE SP IS PRIVATE;

          CONS : CONSTANT SP;

     PRIVATE

          TYPE SP IS RANGE 1 .. 100;

          CONS : CONSTANT SP := 50;

     END PACK;

     USE PACK;

     PACKAGE P IS

          TYPE INT IS PRIVATE;

          TYPE ENUM IS PRIVATE;

          TYPE FIX IS PRIVATE;

          TYPE FLT IS PRIVATE;

          TYPE CON_ARR IS PRIVATE;

          TYPE REC IS PRIVATE;

          TYPE REC1 IS PRIVATE;

          TYPE ACC IS PRIVATE;

          TYPE PRIV IS PRIVATE;

          GENERIC

               TYPE LP IS PRIVATE;

          FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;

          I1, I2, I3, I4 : CONSTANT INT;

          E1, E2, E3, E4 : CONSTANT ENUM;

          FI1, FI2, FI3, FI4 : CONSTANT FIX;

          FL1, FL2, FL3, FL4 : CONSTANT FLT;

          CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;

          R1, R2, R3, R4 : CONSTANT REC;

          R1A, R2A, R3A, R4A : CONSTANT REC1;

          A1, A2, A3, A4 : CONSTANT ACC;

          PR1, PR2, PR3, PR4 : CONSTANT PRIV;

     PRIVATE

          TYPE INT IS RANGE 1 .. 100;

          TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);

          TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;

          TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;

          TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;

          TYPE REC IS RECORD

               COMP1 : INTEGER;

               COMP2 : INTEGER;

               COMP3 : BOOLEAN;

          END RECORD;

          TYPE REC1 IS RECORD

               COMP1 : INTEGER := 10;

               COMP2 : INTEGER := 20;

               COMP3 : BOOLEAN := FALSE;

          END RECORD;

          TYPE ACC IS ACCESS INTEGER;

          TYPE PRIV IS NEW SP;

          FUNCTION DDT IS NEW F1 (INT);

          FUNCTION EDT IS NEW F1 (ENUM);

          FUNCTION FDT IS NEW F2 (FIX);

          FUNCTION FLDT IS NEW F3 (FLT);

          FUNCTION CADT IS NEW F4 (CON_ARR);

          FUNCTION RDT IS NEW F5 (REC);

          FUNCTION R1DT IS NEW F6 (REC1);

          FUNCTION ADT IS NEW F7 (ACC);

          FUNCTION PDT IS NEW F8 (PRIV);

          REC_OBJ : REC := (1,2,TRUE);

          REC1_OBJ : REC1 := (3,4,FALSE);

          I1, I2, I3, I4 : CONSTANT INT := DDT;

          E1, E2, E3, E4 : CONSTANT ENUM := EDT;

          FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;

          FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;

          CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;

          R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);

          R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);

          A1, A2, A3, A4 : CONSTANT ACC := ADT;

          PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));

     END P;

     PACKAGE BODY P IS

          AVAR1 : ACC := NEW INTEGER'(29);

          AVAR2 : ACC := NEW INTEGER'(30);

          AVAR3 : ACC := NEW INTEGER'(31);

          AVAR4 : ACC := NEW INTEGER'(32);

          FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS

          BEGIN

               RETURN Z1 = Z2;

          END GEN_EQUAL;

          FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);

          FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);

          FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);

          FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);

          FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);

          FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);

          FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);

          FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);

          FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);

     BEGIN

          TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &

                           "A DEFERRED CONSTANT IS GIVEN AS A " &

                           "MULTIPLE DECLARATION, THE INITIALIZATION " &

                           "EXPRESSION IS EVALUATED ONCE FOR EACH " &

                           "DEFERRED CONSTANT");

          IF NOT EQUAL(BUMP,36) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");

          END IF;

          IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR

             NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED INTEGER CONSTANTS");

          END IF;

          IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR

             NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED ENUMERATION CONSTANTS");

          END IF;

          IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR

             NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED FIXED POINT CONSTANTS");

          END IF;

          IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR

             NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED FLOATING POINT CONSTANTS");

          END IF;

          IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))

           OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))

               THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                            "DEFERRED ARRAY CONSTANTS");

          END IF;

          IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)

             OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)

               THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                            "DEFERRED RECORD CONSTANTS");

          END IF;

          IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,

             REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT

             REC1_EQUAL(R4A,REC1_OBJ) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED RECORD CONSTANTS WITH DEFAULT " &

                       "EXPRESSIONS");

          END IF;

          IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,

             AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT

             ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED ACCESS CONSTANTS");

          END IF;

          IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,

             PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT

             PRIV_EQUAL(PR4,PRIV(CONS)) THEN

               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &

                       "DEFERRED PRIVATE CONSTANTS");

          END IF;

          RESULT;

     END P;

     USE P;

BEGIN

     NULL;

END C74302B;