1-- AC3106A.ADA
2
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25-- OBJECTIVE:
26--     CHECK THAT AN ACTUAL GENERIC IN OUT PARAMETER CAN BE:
27--          A) ANY SUBCOMPONENT THAT DOES NOT DEPEND ON A DISCRIMINANT,
28--             EVEN IF THE ENCLOSING VARIABLE IS UNCONSTRAINED;
29--          B) ANY SUBCOMPONENT OF AN UNCONSTAINED VARIABLE OF A
30--             RECORD TYPE IF THE DISCRIMINANTS OF THE
31--             VARIABLE DO NOT HAVE DEFAULTS AND THE VARIABLE IS NOT
32--             A GENERIC FORMAL IN OUT PARAMETER;
33--          C) ANY COMPONENT OF AN OBJECT DESIGNATED BY AN ACCESS
34--             VALUE.
35
36-- HISTORY:
37--     RJW 11/07/88  CREATED ORIGINAL TEST.
38
39WITH REPORT; USE REPORT;
40PROCEDURE AC3106A IS
41
42     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
43
44     TYPE REC (D : INT := 0) IS RECORD
45          A : INTEGER := 5;
46          CASE D IS
47               WHEN OTHERS =>
48                    V : INTEGER := 5;
49          END CASE;
50     END RECORD;
51
52     TYPE AR_REC IS ARRAY (1 .. 10) OF REC;
53
54     TYPE R_REC IS RECORD
55          E : REC;
56     END RECORD;
57
58     TYPE A_STRING IS ACCESS STRING;
59     TYPE A_REC IS ACCESS REC;
60     TYPE A_AR_REC IS ACCESS AR_REC;
61     TYPE A_R_REC IS ACCESS R_REC;
62
63     TYPE DIS (L : INT := 1) IS RECORD
64          S : STRING (1 .. L) := "A";
65          R : REC (L);
66          AS : A_STRING (1 .. L) := NEW STRING (1 .. L);
67          AR : A_REC (L) := NEW REC (1);
68          RC : REC (3);
69          ARU : A_REC := NEW REC;
70          V_AR : AR_REC;
71          V_R : R_REC;
72          AC_AR : A_AR_REC := NEW AR_REC;
73          AC_R : A_R_REC := NEW R_REC;
74     END RECORD;
75
76     TYPE A_DIS IS ACCESS DIS;
77     AD : A_DIS := NEW DIS;
78
79     TYPE DIS2 (L : INT) IS RECORD
80          S : STRING (1 .. L);
81          R : REC (L);
82          AS : A_STRING (1 .. L);
83          AR : A_REC (L);
84     END RECORD;
85
86     X : DIS;
87
88     SUBTYPE REC3 IS REC (3);
89
90     GENERIC
91          GREC3 : IN OUT REC3;
92     PACKAGE PREC3 IS END PREC3;
93
94     SUBTYPE REC0 IS REC (0);
95
96     GENERIC
97          GREC0 : IN OUT REC0;
98     PACKAGE PREC0 IS END PREC0;
99
100     GENERIC
101          GINT : IN OUT INTEGER;
102     PACKAGE PINT IS END PINT;
103
104     GENERIC
105          GA_REC : IN OUT A_REC;
106     PACKAGE PA_REC IS END PA_REC;
107
108     GENERIC
109          GAR_REC : IN OUT AR_REC;
110     PACKAGE PAR_REC IS END PAR_REC;
111
112     GENERIC
113          GR_REC : IN OUT R_REC;
114     PACKAGE PR_REC IS END PR_REC;
115
116     GENERIC
117          GA_AR_REC : IN OUT A_AR_REC;
118     PACKAGE PA_AR_REC IS END PA_AR_REC;
119
120     GENERIC
121          GA_R_REC : IN OUT A_R_REC;
122     PACKAGE PA_R_REC IS END PA_R_REC;
123
124     TYPE BUFFER (SIZE : INT) IS RECORD
125          POS : NATURAL := 0;
126          VAL : STRING (1 .. SIZE);
127     END RECORD;
128
129     SUBTYPE BUFF_5 IS BUFFER (5);
130
131     GENERIC
132          Y : IN OUT CHARACTER;
133     PACKAGE P_CHAR IS END P_CHAR;
134
135     SUBTYPE STRING5 IS STRING (1 .. 5);
136     GENERIC
137          GSTRING : STRING5;
138     PACKAGE P_STRING IS END P_STRING;
139
140     GENERIC
141          GA_STRING : A_STRING;
142     PACKAGE P_A_STRING IS END P_A_STRING;
143
144     GENERIC
145          X : IN OUT BUFF_5;
146     PACKAGE P_BUFF IS
147          RX : BUFF_5 RENAMES X;
148     END P_BUFF;
149
150     Z : BUFFER (1) := (SIZE => 1, POS =>82, VAL =>"R");
151BEGIN
152     TEST ("AC3106A", "CHECK THE PERMITTED FORMS OF AN ACTUAL " &
153                      "GENERIC IN OUT PARAMETER");
154
155     DECLARE -- A)
156          PACKAGE NPINT3 IS NEW PINT (X.RC.A);
157          PACKAGE NPINT4 IS NEW PINT (X.RC.V);
158          PACKAGE NPREC3 IS NEW PREC3 (X.RC);
159          PACKAGE NPA_REC IS NEW PA_REC (X.ARU);
160          PACKAGE NPINT5 IS NEW PINT (X.ARU.A);
161          PACKAGE NPINT6 IS NEW PINT (X.ARU.V);
162          PACKAGE NPAR_REC IS NEW PAR_REC (X.V_AR);
163          PACKAGE NPREC01 IS NEW PREC0 (X.V_AR (1));
164          PACKAGE NPR_REC IS NEW PR_REC (X.V_R);
165          PACKAGE NPREC02 IS NEW PREC0 (X.V_R.E);
166          PACKAGE NPINT7 IS NEW PINT (X.V_R.E.A);
167
168          PACKAGE NP_BUFF IS NEW P_BUFF (Z);
169          USE NP_BUFF;
170
171          PACKAGE NP_CHAR3 IS NEW P_CHAR (RX.VAL (1));
172
173          PROCEDURE PROC (X : IN OUT BUFFER) IS
174               PACKAGE NP_CHAR4 IS NEW P_CHAR (X.VAL (1));
175          BEGIN
176               NULL;
177          END;
178     BEGIN
179          NULL;
180     END; -- A)
181
182     DECLARE -- B)
183          PROCEDURE PROC (Y : IN OUT DIS2) IS
184               PACKAGE NP_STRING IS NEW P_STRING (Y.S);
185               PACKAGE NP_CHAR IS NEW P_CHAR (Y.S (1));
186               PACKAGE NP_A_STRING IS NEW P_A_STRING (Y.AS);
187               PACKAGE NP_CHAR2 IS NEW P_CHAR (Y.AS (1));
188               PACKAGE NPINT3 IS NEW PINT (Y.R.A);
189               PACKAGE NPINT4 IS NEW PINT (Y.R.V);
190               PACKAGE NPREC3 IS NEW PREC3 (Y.R);
191               PACKAGE NPA_REC IS NEW PA_REC (Y.AR);
192               PACKAGE NPINT5 IS NEW PINT (Y.AR.A);
193               PACKAGE NPINT6 IS NEW PINT (Y.AR.V);
194          BEGIN
195               NULL;
196          END;
197     BEGIN
198          NULL;
199     END; -- B)
200
201     DECLARE -- C)
202          PACKAGE NP_CHAR IS NEW P_CHAR (AD.S (1));
203          PACKAGE NP_A_STRING IS NEW P_A_STRING (AD.AS);
204          PACKAGE NP_CHAR2 IS NEW P_CHAR (AD.AS (1));
205          PACKAGE NPINT3 IS NEW PINT (AD.R.A);
206          PACKAGE NPINT4 IS NEW PINT (AD.R.V);
207          PACKAGE NPREC3 IS NEW PREC3 (AD.R);
208          PACKAGE NPA_REC IS NEW PA_REC (AD.AR);
209          PACKAGE NPINT5 IS NEW PINT (AD.AR.A);
210          PACKAGE NPINT6 IS NEW PINT (AD.AR.V);
211     BEGIN
212          NULL;
213     END; -- C)
214
215     RESULT;
216END AC3106A;
217