Subversion Repositories openrisc_me

-- AC3106A.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 AN ACTUAL GENERIC IN OUT PARAMETER CAN BE:

--          A) ANY SUBCOMPONENT THAT DOES NOT DEPEND ON A DISCRIMINANT,

--             EVEN IF THE ENCLOSING VARIABLE IS UNCONSTRAINED;

--          B) ANY SUBCOMPONENT OF AN UNCONSTAINED VARIABLE OF A

--             RECORD TYPE IF THE DISCRIMINANTS OF THE

--             VARIABLE DO NOT HAVE DEFAULTS AND THE VARIABLE IS NOT

--             A GENERIC FORMAL IN OUT PARAMETER;

--          C) ANY COMPONENT OF AN OBJECT DESIGNATED BY AN ACCESS

--             VALUE.

-- HISTORY:

--     RJW 11/07/88  CREATED ORIGINAL TEST.

WITH REPORT; USE REPORT;

PROCEDURE AC3106A IS

     SUBTYPE INT IS INTEGER RANGE 0 .. 10;

     TYPE REC (D : INT := 0) IS RECORD

          A : INTEGER := 5;

          CASE D IS

               WHEN OTHERS =>

                    V : INTEGER := 5;

          END CASE;

     END RECORD;

     TYPE AR_REC IS ARRAY (1 .. 10) OF REC;

     TYPE R_REC IS RECORD

          E : REC;

     END RECORD;

     TYPE A_STRING IS ACCESS STRING;

     TYPE A_REC IS ACCESS REC;

     TYPE A_AR_REC IS ACCESS AR_REC;

     TYPE A_R_REC IS ACCESS R_REC;

     TYPE DIS (L : INT := 1) IS RECORD

          S : STRING (1 .. L) := "A";

          R : REC (L);

          AS : A_STRING (1 .. L) := NEW STRING (1 .. L);

          AR : A_REC (L) := NEW REC (1);

          RC : REC (3);

          ARU : A_REC := NEW REC;

          V_AR : AR_REC;

          V_R : R_REC;

          AC_AR : A_AR_REC := NEW AR_REC;

          AC_R : A_R_REC := NEW R_REC;

     END RECORD;

     TYPE A_DIS IS ACCESS DIS;

     AD : A_DIS := NEW DIS;

     TYPE DIS2 (L : INT) IS RECORD

          S : STRING (1 .. L);

          R : REC (L);

          AS : A_STRING (1 .. L);

          AR : A_REC (L);

     END RECORD;

     X : DIS;

     SUBTYPE REC3 IS REC (3);

     GENERIC

          GREC3 : IN OUT REC3;

     PACKAGE PREC3 IS END PREC3;

     SUBTYPE REC0 IS REC (0);

     GENERIC

          GREC0 : IN OUT REC0;

     PACKAGE PREC0 IS END PREC0;

     GENERIC

          GINT : IN OUT INTEGER;

     PACKAGE PINT IS END PINT;

     GENERIC

          GA_REC : IN OUT A_REC;

     PACKAGE PA_REC IS END PA_REC;

     GENERIC

          GAR_REC : IN OUT AR_REC;

     PACKAGE PAR_REC IS END PAR_REC;

     GENERIC

          GR_REC : IN OUT R_REC;

     PACKAGE PR_REC IS END PR_REC;

     GENERIC

          GA_AR_REC : IN OUT A_AR_REC;

     PACKAGE PA_AR_REC IS END PA_AR_REC;

     GENERIC

          GA_R_REC : IN OUT A_R_REC;

     PACKAGE PA_R_REC IS END PA_R_REC;

     TYPE BUFFER (SIZE : INT) IS RECORD

          POS : NATURAL := 0;

          VAL : STRING (1 .. SIZE);

     END RECORD;

     SUBTYPE BUFF_5 IS BUFFER (5);

     GENERIC

          Y : IN OUT CHARACTER;

     PACKAGE P_CHAR IS END P_CHAR;

     SUBTYPE STRING5 IS STRING (1 .. 5);

     GENERIC

          GSTRING : STRING5;

     PACKAGE P_STRING IS END P_STRING;

     GENERIC

          GA_STRING : A_STRING;

     PACKAGE P_A_STRING IS END P_A_STRING;

     GENERIC

          X : IN OUT BUFF_5;

     PACKAGE P_BUFF IS

          RX : BUFF_5 RENAMES X;

     END P_BUFF;

     Z : BUFFER (1) := (SIZE => 1, POS =>82, VAL =>"R");

BEGIN

     TEST ("AC3106A", "CHECK THE PERMITTED FORMS OF AN ACTUAL " &

                      "GENERIC IN OUT PARAMETER");

     DECLARE -- A)

          PACKAGE NPINT3 IS NEW PINT (X.RC.A);

          PACKAGE NPINT4 IS NEW PINT (X.RC.V);

          PACKAGE NPREC3 IS NEW PREC3 (X.RC);

          PACKAGE NPA_REC IS NEW PA_REC (X.ARU);

          PACKAGE NPINT5 IS NEW PINT (X.ARU.A);

          PACKAGE NPINT6 IS NEW PINT (X.ARU.V);

          PACKAGE NPAR_REC IS NEW PAR_REC (X.V_AR);

          PACKAGE NPREC01 IS NEW PREC0 (X.V_AR (1));

          PACKAGE NPR_REC IS NEW PR_REC (X.V_R);

          PACKAGE NPREC02 IS NEW PREC0 (X.V_R.E);

          PACKAGE NPINT7 IS NEW PINT (X.V_R.E.A);

          PACKAGE NP_BUFF IS NEW P_BUFF (Z);

          USE NP_BUFF;

          PACKAGE NP_CHAR3 IS NEW P_CHAR (RX.VAL (1));

          PROCEDURE PROC (X : IN OUT BUFFER) IS

               PACKAGE NP_CHAR4 IS NEW P_CHAR (X.VAL (1));

          BEGIN

               NULL;

          END;

     BEGIN

          NULL;

     END; -- A)

     DECLARE -- B)

          PROCEDURE PROC (Y : IN OUT DIS2) IS

               PACKAGE NP_STRING IS NEW P_STRING (Y.S);

               PACKAGE NP_CHAR IS NEW P_CHAR (Y.S (1));

               PACKAGE NP_A_STRING IS NEW P_A_STRING (Y.AS);

               PACKAGE NP_CHAR2 IS NEW P_CHAR (Y.AS (1));

               PACKAGE NPINT3 IS NEW PINT (Y.R.A);

               PACKAGE NPINT4 IS NEW PINT (Y.R.V);

               PACKAGE NPREC3 IS NEW PREC3 (Y.R);

               PACKAGE NPA_REC IS NEW PA_REC (Y.AR);

               PACKAGE NPINT5 IS NEW PINT (Y.AR.A);

               PACKAGE NPINT6 IS NEW PINT (Y.AR.V);

          BEGIN

               NULL;

          END;

     BEGIN

          NULL;

     END; -- B)

     DECLARE -- C)

          PACKAGE NP_CHAR IS NEW P_CHAR (AD.S (1));

          PACKAGE NP_A_STRING IS NEW P_A_STRING (AD.AS);

          PACKAGE NP_CHAR2 IS NEW P_CHAR (AD.AS (1));

          PACKAGE NPINT3 IS NEW PINT (AD.R.A);

          PACKAGE NPINT4 IS NEW PINT (AD.R.V);

          PACKAGE NPREC3 IS NEW PREC3 (AD.R);

          PACKAGE NPA_REC IS NEW PA_REC (AD.AR);

          PACKAGE NPINT5 IS NEW PINT (AD.AR.A);

          PACKAGE NPINT6 IS NEW PINT (AD.AR.V);

     BEGIN

          NULL;

     END; -- C)

     RESULT;

END AC3106A;