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