1-- CA11010.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 a private child package can use entities declared in the 28-- private part of its parent unit. 29-- 30-- TEST DESCRIPTION: 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. 34-- 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 40-- reset properly. 41-- 42-- 43-- CHANGE HISTORY: 44-- 06 Dec 94 SAIC ACVC 2.0 45-- 46 47package CA11010_0 is -- Package OS. 48 49 type File_Descriptor_Type is private; 50 51 Default_Descriptor : constant File_Descriptor_Type; 52 53 function Initialize_File return File_Descriptor_Type; 54 procedure Verify_Initial_Conditions (Status : out Boolean); 55 function Final_Conditions_Valid return Boolean; 56 57private 58 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); 64 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; 72 73 type File_Type is tagged 74 record 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; 80 end record; 81 82 type File_Array_Type is array (1 .. Max_Files) of File_Type; 83 84 File_Table : File_Array_Type; 85 File_Counter : Integer := 0; 86 87 -- 88 89 function Get_File_Name return File_Name_Type; 90 91end CA11010_0; -- Package OS. 92 93 --=================================================================-- 94 95-- Subprograms that perform the actual file operations are contained in a 96-- private package so that they are not accessible to any client. 97 98private package CA11010_0.CA11010_1 is -- Package OS.Internals 99 100 Private_File_Counter : Integer renames File_Counter; -- Parent priv. object. 101 102 function Initialize 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. 106 107end CA11010_0.CA11010_1; -- Package OS.Internals 108 109 --=================================================================-- 110 111package body CA11010_0.CA11010_1 is -- Package body OS.Internals 112 113 function Next_Available_File return File_Descriptor_Type is 114 begin 115 Private_File_Counter := Private_File_Counter + 1; 116 return (File_Descriptor_Type(File_Counter)); 117 end Next_Available_File; 118 ---------------------------------------------------------------- 119 function Initialize 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; 124 begin 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; 131 return (Number); 132 end Initialize; 133 134end CA11010_0.CA11010_1; -- Package body OS.Internals 135 136 --=================================================================-- 137 138with CA11010_0.CA11010_1; -- Private child package "withed" by 139 -- parent body. 140 141package body CA11010_0 is -- Package body OS 142 143 function Get_File_Name return File_Name_Type is 144 begin 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. 148 149 -- This subprogram utilizes a call to a subprogram contained in a private 150 -- child to perform the actual processing. 151 152 function Initialize_File return File_Descriptor_Type is 153 begin 154 return (CA11010_0.CA11010_1.Initialize); -- No parameters are needed, 155 -- since defaults have been 156 -- provided. 157 end Initialize_File; 158 159 -- 160 -- Separate subunits. 161 -- 162 163 procedure Verify_Initial_Conditions (Status : out Boolean) is separate; 164 165 function Final_Conditions_Valid return Boolean is separate; 166 167end CA11010_0; -- Package body OS 168 169 --=================================================================-- 170 171separate (CA11010_0) 172procedure Verify_Initial_Conditions (Status : out Boolean) is 173begin 174 Status := False; 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) 180 then 181 Status := True; 182 end if; 183end Verify_Initial_Conditions; 184 185 --=================================================================-- 186 187separate (CA11010_0) 188function Final_Conditions_Valid return Boolean is 189begin 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))) 195 then 196 return (True); 197 else 198 return (False); 199 end if; 200end Final_Conditions_Valid; 201 202 --=================================================================-- 203 204with CA11010_0; -- with Package OS. 205with Report; 206 207procedure CA11010 is 208 209 package OS renames CA11010_0; 210 211 Ada_File_Key : OS.File_Descriptor_Type := OS.Default_Descriptor; 212 Initialization_Status : Boolean := False; 213 214begin 215 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. 222 223 Report.Test ("CA11010", "Check that a private child package can use " & 224 "entities declared in the private part of its " & 225 "parent unit"); 226 227 -- Check initial conditions of the first entry in the file table. 228 -- These are all default values provided in the declaration of the 229 -- type File_Type. 230 231 OS.Verify_Initial_Conditions (Initialization_Status); 232 233 if not Initialization_Status then 234 Report.Failed ("Initial condition failure"); 235 end if; 236 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. 242 243 Ada_File_Key := OS.Initialize_File; 244 245 -- Verify that the initial conditions of the file table component have 246 -- been properly modified by the initialization function. 247 248 if not OS.Final_Conditions_Valid then 249 Report.Failed ("Initialization processing failure"); 250 end if; 251 252 Report.Result; 253 254end CA11010; 255