Subversion Repositories openrisc

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

--*

-- CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY

-- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS.

-- TBN  12/01/86

WITH REPORT; USE REPORT;

PROCEDURE CC3123A IS

BEGIN

     TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " &

                      "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " &

                      "NO ACTUAL PARAMETERS");

     DECLARE

          TYPE ENUM IS (I, II, III);

          OBJ_INT : INTEGER := 1;

          OBJ_ENUM : ENUM := I;

          GENERIC

               GEN_INT : IN INTEGER := IDENT_INT(2);

               GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE);

               GEN_ENUM : IN ENUM := II;

          PACKAGE P IS

               PAC_INT : INTEGER := GEN_INT;

               PAC_BOOL : BOOLEAN := GEN_BOOL;

               PAC_ENUM : ENUM := GEN_ENUM;

          END P;

          PACKAGE P1 IS NEW P;

          PACKAGE P2 IS

               NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM);

          PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE));

     BEGIN

          IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN

               FAILED ("DEFAULT VALUES WERE NOT EVALUATED");

          END IF;

          IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN

               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &

                       "- 1");

          END IF;

          IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR

               P3.PAC_ENUM /= II THEN

               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &

                       "- 2");

          END IF;

     END;

     -------------------------------------------------------------------

     DECLARE

          OBJ_INT1 : INTEGER := 3;

          FUNCTION FUNC (X : INTEGER) RETURN INTEGER;

          GENERIC

               GEN_INT1 : IN INTEGER := FUNC (1);

               GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1);

          PROCEDURE PROC;

          PROCEDURE PROC IS

               PROC_INT1 : INTEGER := GEN_INT1;

               PROC_INT2 : INTEGER := GEN_INT2;

          BEGIN

               IF PROC_INT1 /= 3 THEN

                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &

                            "CORRECTLY - 3");

               END IF;

               IF PROC_INT2 /= 4 THEN

                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &

                            "CORRECTLY - 4");

               END IF;

          END PROC;

          FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS

          BEGIN

               IF X /= IDENT_INT(4) THEN

                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &

                            "CORRECTLY - 5");

               END IF;

               RETURN IDENT_INT(X);

          END FUNC;

          PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1);

     BEGIN

          NEW_PROC;

     END;

     -------------------------------------------------------------------

     DECLARE

          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;

          TYPE REC IS

               RECORD

                    ANS : BOOLEAN;

                    ARA : ARA_TYP;

               END RECORD;

          TYPE ARA_REC IS ARRAY (1 .. 5) OF REC;

          FUNCTION F (X : INTEGER) RETURN INTEGER;

          OBJ_REC : REC := (FALSE, (3, 4));

          OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4)));

          GENERIC

               GEN_OBJ1 : IN ARA_TYP := (F(1), 2);

               GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1);

               GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2)));

          FUNCTION FUNC RETURN INTEGER;

          FUNCTION FUNC RETURN INTEGER IS

          BEGIN

               RETURN IDENT_INT(1);

          END FUNC;

          FUNCTION F (X : INTEGER) RETURN INTEGER IS

          BEGIN

               FAILED ("DEFAULT VALUES WERE EVALUATED - 1");

               RETURN IDENT_INT(X);

          END F;

          FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA);

     BEGIN

          IF NOT EQUAL (NEW_FUNC, 1) THEN

               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1");

          END IF;

     END;

     -------------------------------------------------------------------

     DECLARE

          SUBTYPE INT IS INTEGER RANGE 1 .. 5;

          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;

          TYPE COLOR IS (RED, WHITE);

          TYPE CON_REC (D : INT) IS

               RECORD

                    A : COLOR;

                    B : ARA_TYP;

               END RECORD;

          TYPE UNCON_OR_CON_REC (D : INT := 2) IS

               RECORD

                    A : COLOR;

                    B : ARA_TYP;

               END RECORD;

          FUNCTION F (X : COLOR) RETURN COLOR;

          OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4));

          OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4));

          OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4));

          GENERIC

               GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2));

               GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2));

               GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON;

          FUNCTION FUNC RETURN INTEGER;

          FUNCTION FUNC RETURN INTEGER IS

          BEGIN

               RETURN IDENT_INT(1);

          END FUNC;

          FUNCTION F (X : COLOR) RETURN COLOR IS

          BEGIN

               FAILED ("DEFAULT VALUES WERE EVALUATED - 2");

               RETURN WHITE;

          END F;

          FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2);

     BEGIN

          IF NOT EQUAL (NEW_FUNC, 1) THEN

               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2");

          END IF;

     END;

     RESULT;

END CC3123A;