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