1-- CDE0001.A
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--
26-- OBJECTIVE:
27--      Check that the following names can be used in the declaration of a
28--      generic formal parameter (object, array type, or access type) without
29--      causing freezing of the named type:
30--        (1) The name of a private type,
31--        (2) A name that denotes a subtype of a private type, and
32--        (3) A name that denotes a composite type with a subcomponent of a
33--           private type (or subtype).
34--      Check for untagged and tagged types.
35--
36-- TEST DESCRIPTION:
37--      This transition test defines private and limited private types,
38--      subtypes of these private types, records and arrays of both types and
39--      subtypes, a tagged type and a private extension.
40--      This test creates examples where the above types are used in the
41--      definition of several generic formal type parameters (object, array
42--      type, or access type) in both visible and private parts.  These
43--      visible and private generic packages are instantiated in the body of
44--      the public child and the private child, respectively.
45--      The main program utilizes the functions declared in the public child
46--      to verify results of the instantiations.
47--
48--      Inspired by B74103F.ADA.
49--
50--
51-- CHANGE HISTORY:
52--      12 Mar 96   SAIC    Initial version for ACVC 2.1.
53--      05 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate for CDE0001.
54--      21 Nov 98   RLB     Added pragma Elaborate for CDE0001 to CDE0001_3.
55--!
56
57package CDE0001_0 is
58
59   subtype Small_Int is Integer range 1 .. 2;
60
61   type Private_Type    is private;
62   type Limited_Private is limited private;
63
64   subtype Private_Subtype         is Private_Type;
65   subtype Limited_Private_Subtype is Limited_Private;
66
67   type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype;
68
69   type Rec_Of_Limited_Private is
70     record
71        C1 : Limited_Private;
72     end record;
73
74   type Rec_Of_Private_SubType is
75     record
76        C1 : Private_SubType;
77     end record;
78
79   type Tag_Type is tagged
80     record
81        C1 : Small_Int;
82     end record;
83
84   type New_TagType is new Tag_Type with private;
85
86   generic
87
88      Formal_Obj01 : in out Private_Type;              -- Formal objects defined
89      Formal_Obj02 : in out Limited_Private;           -- by names of private
90      Formal_Obj03 : in out Private_Subtype;           -- types, names that
91      Formal_Obj04 : in out Limited_Private_Subtype;   -- denotes subtypes of
92      Formal_Obj05 : in out New_TagType;               -- the private types.
93
94   package CDE0001_1 is
95      procedure Assign_Objects;
96
97   end CDE0001_1;
98
99private
100
101   generic
102      -- Formal array types of a private type, a composite type with a
103      -- subcomponent of a private type.
104
105      type Formal_Arr01 is array (Small_Int) of Private_Type;
106      type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
107
108      -- Formal access types of composite types with a subcomponent of
109      -- a private subtype.
110
111      type Formal_Acc01 is access Rec_Of_Private_Subtype;
112      type Formal_Acc02 is access Array_Of_LP_Subtype;
113
114   package CDE0001_2 is
115
116      procedure Assign_Arrays (P1 : out Formal_Arr01;
117                               P2 : out Formal_Arr02);
118
119      procedure Assign_Access (P1 : out Formal_Acc01;
120                               P2 : out Formal_Acc02);
121
122   end CDE0001_2;
123
124   ----------------------------------------------------------
125   type Private_Type    is range 1 .. 10;
126   type Limited_Private is (Eh, Bee, Sea, Dee);
127   type New_TagType     is new Tag_Type with
128     record
129        C2 : Private_Type;
130     end record;
131
132end CDE0001_0;
133
134     --==================================================================--
135
136package body CDE0001_0 is
137
138   package body CDE0001_1 is
139
140      procedure Assign_Objects is
141      begin
142         Formal_Obj01 := Private_Type'First;
143         Formal_Obj02 := Limited_Private'Last;
144         Formal_Obj03 := Private_Subtype'Last;
145         Formal_Obj04 := Limited_Private_Subtype'First;
146         Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last);
147
148      end Assign_Objects;
149
150   end CDE0001_1;
151
152   --===========================================================--
153
154   package body CDE0001_2 is
155
156      procedure Assign_Arrays (P1 : out Formal_Arr01;
157                               P2 : out Formal_Arr02) is
158      begin
159         P1(1)    := Private_Type'Pred(Private_Type'Last);
160         P1(2)    := Private_Type'Succ(Private_Type'First);
161         P2(1).C1 := Limited_Private'Succ(Limited_Private'First);
162         P2(2).C1 := Limited_Private'Pred(Limited_Private'Last);
163
164      end Assign_Arrays;
165
166      -----------------------------------------------------------------
167      procedure Assign_Access (P1 : out Formal_Acc01;
168                               P2 : out Formal_Acc02) is
169      begin
170         P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last);
171         P2 := new Array_Of_LP_Subtype'(Eh, Dee);
172
173      end Assign_Access;
174
175   end CDE0001_2;
176
177end CDE0001_0;
178
179     --==================================================================--
180
181-- The following private child package instantiates its parent private generic
182-- package.
183
184with CDE0001_0;
185pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated.
186private
187package CDE0001_0.CDE0001_3 is
188
189   type Arr01 is array (Small_Int) of Private_Type;
190   type Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
191   type Acc01 is access Rec_Of_Private_Subtype;
192   type Acc02 is access Array_Of_LP_Subtype;
193
194   package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02);
195
196   Arr01_Obj : Arr01;
197   Arr02_Obj : Arr02;
198   Acc01_Obj : Acc01;
199   Acc02_Obj : Acc02;
200
201end CDE0001_0.CDE0001_3;
202
203     --==================================================================--
204
205package CDE0001_0.CDE0001_4 is
206
207   -- The following functions check the private types defined in the parent
208   -- and the private child package from within the client program.
209
210   function Verify_Objects return Boolean;
211
212   function Verify_Arrays return Boolean;
213
214   function Verify_Access return Boolean;
215
216end CDE0001_0.CDE0001_4;
217
218     --==================================================================--
219
220with CDE0001_0.CDE0001_3;            -- private sibling.
221
222pragma Elaborate (CDE0001_0.CDE0001_3);
223
224package body CDE0001_0.CDE0001_4 is
225
226   Obj1 : Private_Type            := 2;
227   Obj2 : Limited_Private         := Bee;
228   Obj3 : Private_Subtype         := 3;
229   Obj4 : Limited_Private_Subtype := Sea;
230   Obj5 : New_TagType             := (1, 5);
231
232   -- Instantiate the generic package declared in the visible part of
233   -- the parent.
234
235   package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5);
236
237   ---------------------------------------------------
238   function Verify_Objects return Boolean is
239      Result : Boolean := False;
240   begin
241      if Obj1    = 1    and
242         Obj2    = Dee  and
243         Obj3    = 10   and
244         Obj4    = Eh   and
245         Obj5.C1 = 2    and
246         Obj5.C2 = 10   then
247           Result := True;
248      end if;
249
250      return Result;
251
252   end Verify_Objects;
253
254   ---------------------------------------------------
255   function Verify_Arrays return Boolean is
256      Result : Boolean := False;
257   begin
258      if CDE0001_0.CDE0001_3.Arr01_Obj(1)    = 9     and
259         CDE0001_0.CDE0001_3.Arr01_Obj(2)    = 2     and
260         CDE0001_0.CDE0001_3.Arr02_Obj(1).C1 = Bee   and
261         CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea   then
262           Result := True;
263      end if;
264
265      return Result;
266
267   end Verify_Arrays;
268
269   ---------------------------------------------------
270   function Verify_Access return Boolean is
271      Result : Boolean := False;
272   begin
273      if CDE0001_0.CDE0001_3.Acc01_Obj.C1  = 10   and
274         CDE0001_0.CDE0001_3.Acc02_Obj(1)  = Eh   and
275         CDE0001_0.CDE0001_3.Acc02_Obj(2)  = Dee  then
276            Result := True;
277      end if;
278
279      return Result;
280
281   end Verify_Access;
282
283begin
284
285   Formal_Obj_Pck.Assign_Objects;
286
287   CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Arrays
288     (CDE0001_0.CDE0001_3.Arr01_Obj, CDE0001_0.CDE0001_3.Arr02_Obj);
289   CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access
290     (CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj);
291
292end CDE0001_0.CDE0001_4;
293
294     --==================================================================--
295
296with Report;
297with CDE0001_0.CDE0001_4;
298
299procedure CDE0001 is
300
301begin
302
303   Report.Test ("CDE0001", "Check that the name of the private type, a "  &
304                "name that denotes a subtype of the private type, or a "  &
305                "name that denotes a composite type with a subcomponent " &
306                "of a private type can be used in the declaration of a "  &
307                "generic formal type parameter without causing freezing " &
308                "of the named type");
309
310   if not CDE0001_0.CDE0001_4.Verify_Objects then
311      Report.Failed ("Wrong values for formal objects");
312   end if;
313
314   if not CDE0001_0.CDE0001_4.Verify_Arrays then
315      Report.Failed ("Wrong values for formal array types");
316   end if;
317
318   if not CDE0001_0.CDE0001_4.Verify_Access then
319      Report.Failed ("Wrong values for formal access types");
320   end if;
321
322   Report.Result;
323
324end CDE0001;
325