1-- CA11008.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-- visible part of its parent unit. 29-- 30-- TEST DESCRIPTION: 31-- Declare a parent package containing types and objects used 32-- by the system. Declare a private child package that uses the parent 33-- components to provide functionality to the system. 34-- 35-- The tagged file type defined in the parent has defaults for all 36-- component fields. Prior to initialization, these values are checked 37-- to ensure a correct start condition. The initial subprogram is 38-- called, which utilizes the functionality provided in the private 39-- child package. This subprogram changes the fields of the file object 40-- to something other than the default values, and this process is then 41-- verified at the conclusion of the test. 42-- 43-- 44-- CHANGE HISTORY: 45-- 06 Dec 94 SAIC ACVC 2.0 46-- 47--! 48 49package CA11008_0 is -- Package OS. 50 51 type File_Descriptor_Type is new Integer; 52 type File_Name_Type is new String (1 .. 11); 53 type Permission_Type is (None, User, System, Bypass); 54 type File_Mode_Type is (Read_Only, Write_Only, Read_Write); 55 type File_Status_Type is (Open, Closed); 56 57 Default_Descriptor : constant File_Descriptor_Type := 0; 58 Default_Permission : constant Permission_Type := None; 59 Default_Mode : constant File_Mode_Type := Read_Only; 60 Default_Status : constant File_Status_Type := Closed; 61 Default_Filename : constant File_Name_Type := " "; 62 63 Max_Files : constant File_Descriptor_Type := 100; 64 Constant_Name : constant File_Name_Type := "AdaFileName"; 65 File_Counter : Integer := 0; 66 67 type File_Type is tagged 68 record 69 Descriptor : File_Descriptor_Type := Default_Descriptor; 70 Name : File_Name_Type := Default_Filename; 71 Acct_Access : Permission_Type := Default_Permission; 72 Mode : File_Mode_Type := Default_Mode; 73 Current_Status : File_Status_Type := Default_Status; 74 end record; 75 76 type File_Array_Type is array (1 .. Max_Files) of File_Type; 77 78 File_Table : File_Array_Type; 79 80 -- 81 82 function Get_File_Name return File_Name_Type; 83 84 function Initialize_File return File_Descriptor_Type; 85 86end CA11008_0; -- Package OS. 87 88 --=================================================================-- 89 90-- Subprograms that perform the actual file operations are contained in a 91-- private package so that they are not accessible to any client. 92 93private package CA11008_0.CA11008_1 is -- Package OS.Internals 94 95 Private_File_Counter : Integer renames File_Counter; -- Parent 96 -- object. 97 function Initialize 98 (File_Name : File_Name_Type := Get_File_Name; -- Parent function. 99 File_Mode : File_Mode_Type := Read_Write) -- Parent literal. 100 return File_Descriptor_Type; -- Parent type. 101 102end CA11008_0.CA11008_1; -- Package OS.Internals 103 104 --=================================================================-- 105 106package body CA11008_0.CA11008_1 is -- Package body OS.Internals 107 108 function Next_Available_File return File_Descriptor_Type is 109 begin 110 Private_File_Counter := Private_File_Counter + 1; 111 return (File_Descriptor_Type(File_Counter)); 112 end Next_Available_File; 113 ----------------------------------------------------------------- 114 function Initialize 115 (File_Name : File_Name_Type := Get_File_Name; -- Parent function 116 File_Mode : File_Mode_Type := Read_Write) -- Parent literal 117 return File_Descriptor_Type is -- Parent type 118 Number : File_Descriptor_Type; 119 begin 120 Number := Next_Available_File; 121 File_Table(Number).Descriptor := Number; -- Parent object 122 File_Table(Number).Name := File_Name; -- Default parameter value 123 File_Table(Number).Mode := File_Mode; -- Default parameter value 124 File_Table(Number).Acct_Access := User; 125 File_Table(Number).Current_Status := Open; 126 return (Number); 127 end Initialize; 128 129end CA11008_0.CA11008_1; -- Package body OS.Internals 130 131 --=================================================================-- 132 133with CA11008_0.CA11008_1; -- Private child package "withed" by 134 -- parent body. 135 136package body CA11008_0 is -- Package body OS 137 138 function Get_File_Name return File_Name_Type is 139 begin 140 return (Constant_Name); -- Of course if this was a real function, the 141 end Get_File_Name; -- user would be asked to input a name, or 142 -- there would be some type of similar process. 143 144 -- This subprogram utilizes a call to a subprogram contained in a private 145 -- child to perform the actual processing. 146 147 function Initialize_File return File_Descriptor_Type is 148 begin 149 return (CA11008_0.CA11008_1.Initialize); -- No parameters are needed, 150 -- since defaults have been 151 -- provided. 152 end Initialize_File; 153 154end CA11008_0; -- Package body OS 155 156 --=================================================================-- 157 158with CA11008_0; -- with Package OS. 159with Report; 160 161procedure CA11008 is 162 163 package OS renames CA11008_0; 164 use OS; 165 Ada_File_Key : File_Descriptor_Type := Default_Descriptor; 166 167begin 168 169 -- This test indicates one approach to file management operations. 170 -- It is not intended to demonstrate full functionality, but rather 171 -- that the use of a private child package can provide a solution 172 -- to a user situation, that being the implementation of certain functions 173 -- being provided in a child package, with the parent package body 174 -- utilizing these implementations. 175 176 Report.Test ("CA11008", "Check that a private child package can use " & 177 "entities declared in the visible part of its " & 178 "parent unit"); 179 180 -- Check initial conditions of the first entry in the file table. 181 -- These are all default values provided in the declaration of the 182 -- type File_Type. 183 184 if (Ada_File_Key /= Default_Descriptor) or else 185 (File_Table(1).Descriptor /= (Default_Descriptor) or 186 (File_Table(1).Name /= Default_Filename)) or else 187 (File_Table(1).Acct_Access /= (Default_Permission) or 188 (File_Table(1).Mode /= Default_Mode)) or else 189 (File_Table(1).Current_Status /= Default_Status) 190 then 191 Report.Failed ("Initial condition failure"); 192 end if; 193 194 -- Call the initialization function. This will result in the resetting 195 -- of the fields associated with the first entry in the File_Table (this 196 -- is the first call of Initialize_File). 197 -- No parameters are necessary for this call, due to the default values 198 -- provided in the private child package routine Initialize. 199 200 Ada_File_Key := Initialize_File; 201 202 -- Verify that the initial conditions of the file table component have 203 -- been properly modified by the initialization function. 204 205 if not ((File_Table(1).Descriptor = Ada_File_Key) and then 206 (File_Table(1).Name = Constant_Name) and then 207 (File_Table(1).Acct_Access = User) and then 208 not ((File_Table(1).Mode = Default_Mode) or else 209 (File_Table(1).Current_Status = Default_Status))) 210 then 211 Report.Failed ("Initialization processing failure"); 212 end if; 213 214 Report.Result; 215 216end CA11008; 217