3 -- Grant of Unlimited Rights
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
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.
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.
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.
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.
52 -- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
55 type File_Descriptor
is limited private;
57 type File_Mode
is limited private;
59 Active_Mode
: constant File_Mode
;
61 type File_Name
is limited private;
63 type File_Type
is limited private;
65 function Next_Available_File
return File_Descriptor
;
69 type File_Descriptor
is new Integer;
71 Null_File
: constant File_Descriptor
:= 0;
72 First_File
: constant File_Descriptor
:= 1;
75 (Read_Only
, Write_Only
, Read_Write
, Archived
, Corrupt
, Lost
);
77 Default_Mode
: constant File_Mode
:= Read_Only
;
78 Active_Mode
: constant File_Mode
:= Read_Write
;
80 type File_Name
is array (1 .. 6) of Character;
82 Null_String
: File_Name
:= " ";
83 String1
: File_Name
:= "ACVC ";
84 String2
: File_Name
:= " 1995";
88 Descriptor
: File_Descriptor
:= Null_File
;
89 Mode
: File_Mode
:= Default_Mode
;
90 Name
: File_Name
:= Null_String
;
95 --=================================================================--
97 package body C730004_0
is
99 File_Count
: Integer := 0;
101 function Next_Available_File
return File_Descriptor
is
103 File_Count
:= File_Count
+ 1;
104 return (File_Descriptor
(File_Count
)); -- Type conversion.
105 end Next_Available_File
;
109 --=================================================================--
112 package C730004_0
.C730004_1
is -- private child
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
118 System_File_Name
: constant File_Name
119 := String1
(1..4) & String2
(5..6);
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
125 function New_File_Validated
(File
: File_Type
126 := (Descriptor
=> First_File
,
128 Name
=> System_File_Name
))
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.
135 System_File
: File_Type
136 := (Null_File
, Read_Only
, System_File_Name
);
139 end C730004_0
.C730004_1
;
141 --=================================================================--
143 package body C730004_0
.C730004_1
is
145 function New_File_Validated
(File
: File_Type
146 := (Descriptor
=> First_File
,
148 Name
=> System_File_Name
))
150 Result
: Boolean := False;
152 if (File
.Descriptor
> System_File
.Descriptor
) and
153 (File
.Mode
in Read_Only
.. Read_Write
) and (File
.Name
= "ACVC95")
160 end New_File_Validated
;
162 end C730004_0
.C730004_1
;
164 --=================================================================--
166 package C730004_0
.C730004_2
is -- public child
168 -- File_Type is limited here.
170 procedure Create_File
(File
: out File_Type
);
172 procedure Modify_File
(File
: out File_Type
);
174 type File_Dir
is limited private;
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.
180 function Validate_Create
(File
: in File_Type
) return Boolean;
182 function Validate_Modification
(File
: in File_Type
)
185 function Validate_Dir
(Dir
: in File_Dir
) return Boolean;
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.
193 Child_File
: File_Type
194 := File_Type
'(Descriptor => Null_File,
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.
204 Comp : File_Type := Child_File;
207 end C730004_0.C730004_2;
209 --=================================================================--
211 with C730004_0.C730004_1;
213 package body C730004_0.C730004_2 is
215 procedure Create_File (File : out File_Type) is
216 New_File : File_Type;
219 New_File.Descriptor := Next_Available_File;
220 New_File.Mode := Default_Mode;
221 New_File.Name := C730004_0.C730004_1.System_File_Name;
223 if C730004_0.C730004_1.New_File_Validated (New_File) then
226 File := (Null_File, Lost, "MISSED");
231 --------------------------------------------------------------
232 procedure Modify_File (File : out File_Type) is
234 File.Descriptor := Next_Available_File;
235 File.Mode := Active_Mode;
236 File.Name := String1;
239 --------------------------------------------------------------
240 function Validate_Create (File : in File_Type) return Boolean is
242 if ((File.Descriptor /= Child_File.Descriptor) and
243 (File.Mode = Read_Only) and (File.Name = "ACVC95"))
251 ------------------------------------------------------------------------
252 function Validate_Modification (File : in File_Type)
255 if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and
256 (File.Mode = Read_Write) and (File.Name = "ACVC "))
262 end Validate_Modification;
264 ------------------------------------------------------------------------
265 function Validate_Dir (Dir : in File_Dir) return Boolean is
267 if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor)
268 and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
276 end C730004_0.C730004_2;
278 --=================================================================--
280 with C730004_0.C730004_2;
285 package File renames C730004_0;
286 package File_Ops renames C730004_0.C730004_2;
288 Validation_File : File.File_Type;
290 Validation_Dir : File_Ops.File_Dir;
292 ------------------------------------------------------------------------
293 -- Limited File_Type is allowed as an out parameter outside package File.
295 procedure Call_Modify_File (Modified_File : out File.File_Type) is
297 File_Ops.Modify_File (Modified_File);
298 end Call_Modify_File;
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");
309 File_Ops.Create_File (Validation_File);
311 if not File_Ops.Validate_Create (Validation_File) then
312 Report.Failed ("Incorrect creation of file");
315 Call_Modify_File (Validation_File);
317 if not File_Ops.Validate_Modification (Validation_File) then
318 Report.Failed ("Incorrect modification of file");
321 if not File_Ops.Validate_Dir (Validation_Dir) then
322 Report.Failed ("Incorrect creation of directory");