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/] [c7/] [c730004.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C730004.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 for a type declared in a package, descendants of the package
28
--      use the full view of type.  Specifically check that full view of the
29
--      limited type is visible only in private descendants (children) and in
30
--      the private parts and bodies of public descendants (children).
31
--      Check that a limited type may be used as an out parameter outside
32
--      the package that defines the type.
33
--
34
-- TEST DESCRIPTION:
35
--      This test defines a parent package containing limited private type
36
--      definitions. Children packages are defined (one public, one private)
37
--      that use the nonlimited full view of the types defined in the private
38
--      part of the parent specification.
39
--      The main declares a procedure with an out parameter that was defined
40
--      as limited in the specification of the parent package.
41
--
42
--
43
-- CHANGE HISTORY:
44
--      15 Sep 95   SAIC    Initial prerelease version.
45
--      23 Apr 96   SAIC    Added prefix for parameter in Call_Modify_File.
46
--      02 Nov 96   SAIC    ACVC 2.1: Modified prologue and Test.Report.
47
--
48
--!
49
 
50
package C730004_0 is
51
 
52
   -- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
53
   -- are nonlimited.
54
 
55
   type File_Descriptor is limited private;
56
 
57
   type File_Mode is limited private;
58
 
59
   Active_Mode  : constant File_Mode;
60
 
61
   type File_Name is limited private;
62
 
63
   type File_Type is limited private;
64
 
65
   function Next_Available_File return File_Descriptor;
66
 
67
private
68
 
69
   type File_Descriptor is new Integer;
70
 
71
   Null_File    : constant File_Descriptor := 0;
72
   First_File   : constant File_Descriptor := 1;
73
 
74
   type File_Mode is
75
     (Read_Only, Write_Only, Read_Write, Archived, Corrupt, Lost);
76
 
77
   Default_Mode : constant File_Mode       := Read_Only;
78
   Active_Mode  : constant File_Mode       := Read_Write;
79
 
80
   type File_Name is array (1 .. 6) of Character;
81
 
82
   Null_String : File_Name := "      ";
83
   String1     : File_Name := "ACVC  ";
84
   String2     : File_Name := "  1995";
85
 
86
   type File_Type is
87
     record
88
        Descriptor : File_Descriptor := Null_File;
89
        Mode       : File_Mode       := Default_Mode;
90
        Name       : File_Name       := Null_String;
91
     end record;
92
 
93
end C730004_0;
94
 
95
     --=================================================================--
96
 
97
package body C730004_0 is
98
 
99
   File_Count : Integer := 0;
100
 
101
   function Next_Available_File return File_Descriptor is
102
   begin
103
      File_Count := File_Count + 1;
104
      return (File_Descriptor(File_Count));    -- Type conversion.
105
   end Next_Available_File;
106
 
107
end C730004_0;
108
 
109
     --=================================================================--
110
 
111
private
112
package C730004_0.C730004_1 is                             -- private child
113
 
114
   -- Since full view of the nontagged File_Name is nonlimited in the parent
115
   -- package, it is not limited in the private child, so concatenation is
116
   -- available.
117
 
118
   System_File_Name :  constant File_Name
119
                    := String1(1..4) & String2(5..6);
120
 
121
   -- Since full view of the nontagged File_Type is nonlimited in the parent
122
   -- package, it is not limited in the private child, so a default expression
123
   -- is available.
124
 
125
   function New_File_Validated (File :  File_Type
126
                                     := (Descriptor => First_File,
127
                                         Mode       => Active_Mode,
128
                                         Name       => System_File_Name))
129
     return Boolean;
130
 
131
   -- Since full view of the nontagged File_Type is nonlimited in the parent
132
   -- package, it is not limited in the private child, so initialization
133
   -- expression in an object declaration is available.
134
 
135
   System_File      :  File_Type
136
                    := (Null_File, Read_Only, System_File_Name);
137
 
138
 
139
end C730004_0.C730004_1;
140
 
141
     --=================================================================--
142
 
143
package body C730004_0.C730004_1 is
144
 
145
   function New_File_Validated (File :  File_Type
146
                                     := (Descriptor => First_File,
147
                                         Mode       => Active_Mode,
148
                                         Name       => System_File_Name))
149
     return Boolean is
150
      Result : Boolean := False;
151
   begin
152
      if (File.Descriptor > System_File.Descriptor) and
153
         (File.Mode in Read_Only .. Read_Write) and (File.Name = "ACVC95")
154
      then
155
         Result := True;
156
      end if;
157
 
158
      return (Result);
159
 
160
   end New_File_Validated;
161
 
162
end C730004_0.C730004_1;
163
 
164
     --=================================================================--
165
 
166
package C730004_0.C730004_2 is                   -- public child
167
 
168
   -- File_Type is limited here.
169
 
170
   procedure Create_File (File : out File_Type);
171
 
172
   procedure Modify_File (File : out File_Type);
173
 
174
   type File_Dir is limited private;
175
 
176
   -- The following three validation functions provide the capability to
177
   -- check the limited private types defined in the parent and the
178
   -- private child package from within the client program.
179
 
180
   function  Validate_Create (File : in File_Type) return Boolean;
181
 
182
   function  Validate_Modification (File : in File_Type)
183
     return Boolean;
184
 
185
   function  Validate_Dir (Dir : in File_Dir) return Boolean;
186
 
187
private
188
 
189
   -- Since full view of the nontagged File_Type is nonlimited in the parent
190
   -- package, it is not limited in the private part of the public child, so
191
   -- aggregates are available.
192
 
193
   Child_File :  File_Type
194
              := File_Type'(Descriptor => Null_File,
195
                            Mode       => Write_Only,
196
                            Name       => String2);
197
 
198
   -- Since full view of the nontagged component File_Type is nonlimited in
199
   -- the parent package, it is not limited in the private part of the public
200
   -- child, so default expressions are available.
201
 
202
   type File_Dir is
203
     record
204
        Comp : File_Type := Child_File;
205
     end record;
206
 
207
end C730004_0.C730004_2;
208
 
209
     --=================================================================--
210
 
211
with C730004_0.C730004_1;
212
 
213
package body C730004_0.C730004_2 is
214
 
215
   procedure Create_File (File : out File_Type) is
216
      New_File : File_Type;
217
 
218
   begin
219
      New_File.Descriptor := Next_Available_File;
220
      New_File.Mode       := Default_Mode;
221
      New_File.Name       := C730004_0.C730004_1.System_File_Name;
222
 
223
      if C730004_0.C730004_1.New_File_Validated (New_File) then
224
         File := New_File;
225
      else
226
         File := (Null_File, Lost, "MISSED");
227
      end if;
228
 
229
   end Create_File;
230
 
231
   --------------------------------------------------------------
232
   procedure Modify_File (File : out File_Type) is
233
   begin
234
      File.Descriptor := Next_Available_File;
235
      File.Mode       := Active_Mode;
236
      File.Name       := String1;
237
   end Modify_File;
238
 
239
   --------------------------------------------------------------
240
   function  Validate_Create (File : in File_Type) return Boolean is
241
   begin
242
      if ((File.Descriptor /= Child_File.Descriptor) and
243
          (File.Mode = Read_Only) and (File.Name = "ACVC95"))
244
      then
245
         return True;
246
      else
247
         return False;
248
      end if;
249
   end Validate_Create;
250
 
251
   ------------------------------------------------------------------------
252
   function  Validate_Modification (File : in File_Type)
253
      return Boolean is
254
   begin
255
      if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and
256
          (File.Mode = Read_Write) and (File.Name = "ACVC  "))
257
      then
258
         return True;
259
      else
260
         return False;
261
      end if;
262
   end Validate_Modification;
263
 
264
   ------------------------------------------------------------------------
265
   function  Validate_Dir (Dir : in File_Dir) return Boolean is
266
   begin
267
      if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor)
268
        and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
269
      then
270
         return True;
271
      else
272
         return False;
273
      end if;
274
   end Validate_Dir;
275
 
276
end C730004_0.C730004_2;
277
 
278
     --=================================================================--
279
 
280
with C730004_0.C730004_2;
281
with Report;
282
 
283
procedure C730004 is
284
 
285
   package File      renames C730004_0;
286
   package File_Ops  renames C730004_0.C730004_2;
287
 
288
   Validation_File : File.File_Type;
289
 
290
   Validation_Dir  : File_Ops.File_Dir;
291
 
292
   ------------------------------------------------------------------------
293
   -- Limited File_Type is allowed as an out parameter outside package File.
294
 
295
   procedure Call_Modify_File (Modified_File : out File.File_Type) is
296
   begin
297
      File_Ops.Modify_File (Modified_File);
298
   end Call_Modify_File;
299
 
300
begin
301
 
302
   Report.Test ("C730004", "Check that for a type declared in a package, "   &
303
                           "descendants of the package use the full view "   &
304
                           "of the type.  Specifically check that full "     &
305
                           "view of the limited type is visible only in "    &
306
                           "private children and in the private parts and "  &
307
                           "bodies of public children");
308
 
309
   File_Ops.Create_File (Validation_File);
310
 
311
   if not File_Ops.Validate_Create (Validation_File) then
312
      Report.Failed ("Incorrect creation of file");
313
   end if;
314
 
315
   Call_Modify_File (Validation_File);
316
 
317
   if not File_Ops.Validate_Modification (Validation_File) then
318
      Report.Failed ("Incorrect modification of file");
319
   end if;
320
 
321
   if not File_Ops.Validate_Dir (Validation_Dir) then
322
      Report.Failed ("Incorrect creation of directory");
323
   end if;
324
 
325
   Report.Result;
326
 
327
end C730004;

powered by: WebSVN 2.1.0

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