OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cde0001.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- 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
 
57
package 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
 
99
private
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
 
132
end CDE0001_0;
133
 
134
     --==================================================================--
135
 
136
package 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
 
177
end CDE0001_0;
178
 
179
     --==================================================================--
180
 
181
-- The following private child package instantiates its parent private generic
182
-- package.
183
 
184
with CDE0001_0;
185
pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated.
186
private
187
package 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
 
201
end CDE0001_0.CDE0001_3;
202
 
203
     --==================================================================--
204
 
205
package 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
 
216
end CDE0001_0.CDE0001_4;
217
 
218
     --==================================================================--
219
 
220
with CDE0001_0.CDE0001_3;            -- private sibling.
221
 
222
pragma Elaborate (CDE0001_0.CDE0001_3);
223
 
224
package 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
 
283
begin
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
 
292
end CDE0001_0.CDE0001_4;
293
 
294
     --==================================================================--
295
 
296
with Report;
297
with CDE0001_0.CDE0001_4;
298
 
299
procedure CDE0001 is
300
 
301
begin
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
 
324
end CDE0001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.