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 a private child package can use entities declared in the
28 -- private part of its parent unit.
31 -- Declare a parent package containing private types, objects,
32 -- and functions used by the system. Declare a private child package that
33 -- uses the parent components to provide functionality to the system.
35 -- Declare an array of files with default values for all
36 -- component fields of the files (records). Check the initial state of
37 -- a specified file for proper default values. Perform the file "creation"
38 -- (initialization), which will modify the fields of the record object.
39 -- Again verify the file object to determine whether the fields have been
44 -- 06 Dec 94 SAIC ACVC 2.0
47 package CA11010_0
is -- Package OS.
49 type File_Descriptor_Type
is private;
51 Default_Descriptor
: constant File_Descriptor_Type
;
53 function Initialize_File
return File_Descriptor_Type
;
54 procedure Verify_Initial_Conditions
(Status
: out Boolean);
55 function Final_Conditions_Valid
return Boolean;
59 type File_Descriptor_Type
is new Integer;
60 type File_Name_Type
is new String (1 .. 11);
61 type Permission_Type
is (None
, User
, System
);
62 type File_Mode_Type
is (Read_Only
, Write_Only
, Read_Write
);
63 type File_Status_Type
is (Open
, Closed
);
65 Default_Descriptor
: constant File_Descriptor_Type
:= 0;
66 Default_Permission
: constant Permission_Type
:= None
;
67 Default_Mode
: constant File_Mode_Type
:= Read_Only
;
68 Default_Status
: constant File_Status_Type
:= Closed
;
69 Default_Filename
: constant File_Name_Type
:= " ";
70 An_Ada_File_Name
: constant File_Name_Type
:= "AdaFileName";
71 Max_Files
: constant File_Descriptor_Type
:= 100;
73 type File_Type
is tagged
75 Descriptor
: File_Descriptor_Type
:= Default_Descriptor
;
76 Name
: File_Name_Type
:= Default_Filename
;
77 Acct_Access
: Permission_Type
:= Default_Permission
;
78 Mode
: File_Mode_Type
:= Default_Mode
;
79 Current_Status
: File_Status_Type
:= Default_Status
;
82 type File_Array_Type
is array (1 .. Max_Files
) of File_Type
;
84 File_Table
: File_Array_Type
;
85 File_Counter
: Integer := 0;
89 function Get_File_Name
return File_Name_Type
;
91 end CA11010_0
; -- Package OS.
93 --=================================================================--
95 -- Subprograms that perform the actual file operations are contained in a
96 -- private package so that they are not accessible to any client.
98 private package CA11010_0
.CA11010_1
is -- Package OS.Internals
100 Private_File_Counter
: Integer renames File_Counter
; -- Parent priv. object.
103 (File_Name
: File_Name_Type
:= Get_File_Name
; -- Parent priv. function.
104 File_Mode
: File_Mode_Type
:= Read_Write
) -- Parent priv. literal.
105 return File_Descriptor_Type
; -- Parent type.
107 end CA11010_0
.CA11010_1
; -- Package OS.Internals
109 --=================================================================--
111 package body CA11010_0
.CA11010_1
is -- Package body OS.Internals
113 function Next_Available_File
return File_Descriptor_Type
is
115 Private_File_Counter
:= Private_File_Counter
+ 1;
116 return (File_Descriptor_Type
(File_Counter
));
117 end Next_Available_File
;
118 ----------------------------------------------------------------
120 (File_Name
: File_Name_Type
:= Get_File_Name
; -- Parent priv. function
121 File_Mode
: File_Mode_Type
:= Read_Write
) -- Parent priv. literal
122 return File_Descriptor_Type
is -- Parent type
123 Number
: File_Descriptor_Type
;
125 Number
:= Next_Available_File
;
126 File_Table
(Number
).Descriptor
:= Number
; -- Parent priv. object
127 File_Table
(Number
).Name
:= File_Name
; -- Default parameter value
128 File_Table
(Number
).Mode
:= File_Mode
; -- Default parameter value
129 File_Table
(Number
).Acct_Access
:= User
;
130 File_Table
(Number
).Current_Status
:= Open
;
134 end CA11010_0
.CA11010_1
; -- Package body OS.Internals
136 --=================================================================--
138 with CA11010_0
.CA11010_1
; -- Private child package "withed" by
141 package body CA11010_0
is -- Package body OS
143 function Get_File_Name
return File_Name_Type
is
145 return (An_Ada_File_Name
); -- If this was a real function, the user
146 end Get_File_Name
; -- would be asked to input a name, or there
147 -- would be some type of similar processing.
149 -- This subprogram utilizes a call to a subprogram contained in a private
150 -- child to perform the actual processing.
152 function Initialize_File
return File_Descriptor_Type
is
154 return (CA11010_0
.CA11010_1
.Initialize
); -- No parameters are needed,
155 -- since defaults have been
160 -- Separate subunits.
163 procedure Verify_Initial_Conditions
(Status
: out Boolean) is separate;
165 function Final_Conditions_Valid
return Boolean is separate;
167 end CA11010_0
; -- Package body OS
169 --=================================================================--
172 procedure Verify_Initial_Conditions
(Status
: out Boolean) is
175 if (File_Table
(1).Descriptor
= Default_Descriptor
) and then
176 (File_Table
(1).Name
= Default_Filename
) and then
177 (File_Table
(1).Acct_Access
= Default_Permission
) and then
178 (File_Table
(1).Mode
= Default_Mode
) and then
179 (File_Table
(1).Current_Status
= Default_Status
)
183 end Verify_Initial_Conditions
;
185 --=================================================================--
188 function Final_Conditions_Valid
return Boolean is
190 if ((File_Table
(1).Descriptor
/= Default_Descriptor
) and then
191 (File_Table
(1).Name
= An_Ada_File_Name
) and then
192 (File_Table
(1).Acct_Access
= User
) and then
193 not ((File_Table
(1).Mode
= Default_Mode
) or else
194 (File_Table
(1).Current_Status
= Default_Status
)))
200 end Final_Conditions_Valid
;
202 --=================================================================--
204 with CA11010_0
; -- with Package OS.
209 package OS
renames CA11010_0
;
211 Ada_File_Key
: OS
.File_Descriptor_Type
:= OS
.Default_Descriptor
;
212 Initialization_Status
: Boolean := False;
216 -- This test indicates one approach to a file management operation.
217 -- It is not intended to demonstrate full functionality, but rather
218 -- that the use of a private child package can provide a solution
219 -- to a user situation, that being the implementation of certain functions
220 -- being provided in a child package, with the parent package body
221 -- utilizing these implementations.
223 Report
.Test
("CA11010", "Check that a private child package can use " &
224 "entities declared in the private part of its " &
227 -- Check initial conditions of the first entry in the file table.
228 -- These are all default values provided in the declaration of the
231 OS
.Verify_Initial_Conditions
(Initialization_Status
);
233 if not Initialization_Status
then
234 Report
.Failed
("Initial condition failure");
237 -- Call the initialization function. This will result in the resetting
238 -- of the fields associated with the first entry in the File_Table (this
239 -- is the first/only call of Initialize_File).
240 -- No parameters are necessary for this call, due to the default values
241 -- provided in the private child package routine Initialize.
243 Ada_File_Key
:= OS
.Initialize_File
;
245 -- Verify that the initial conditions of the file table component have
246 -- been properly modified by the initialization function.
248 if not OS
.Final_Conditions_Valid
then
249 Report
.Failed
("Initialization processing failure");