1-- CA11009.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 the parent unit of its parent unit. 29-- 30-- TEST DESCRIPTION: 31-- Declare a parent package containing types and objects used by the 32-- system. Declare a public child package that provides a visible 33-- interface to the system functionality. 34-- Declare a private grandchild package that uses the visible grandparent 35-- components to provide the actual functionality to the system. 36-- 37-- The public child (parent of the private grandchild) uses the 38-- functionality of its private child (grandchild package) to provide 39-- the visible interface to operations of the system. 40-- 41-- The test itself will utilize the visible interface provided in the 42-- public child package to demonstrate a possible structure for 43-- file management. 44-- 45-- 46-- CHANGE HISTORY: 47-- 06 Dec 94 SAIC ACVC 2.0 48-- 15 Apr 96 SAIC ACVC 2.1: Added pragma Elaborate_body. 49-- 50--! 51 52package CA11009_0 is -- Package OS. 53 pragma Elaborate_Body (CA11009_0); 54 55 type File_Descriptor_Type is new Integer; 56 type File_Name_Type is new String (1 .. 11); 57 type Permission_Type is (None, User, System, Bypass); 58 type File_Mode_Type is (Read_Only, Write_Only, Read_Write); 59 type File_Status_Type is (Open, Closed); 60 61 Default_Descriptor : constant File_Descriptor_Type := 0; 62 Default_Permission : constant Permission_Type := None; 63 Default_Mode : constant File_Mode_Type := Read_Only; 64 Default_Status : constant File_Status_Type := Closed; 65 Default_Filename : constant File_Name_Type := " "; 66 67 Max_Files : constant File_Descriptor_Type := 10; 68 An_Ada_File_Name : constant File_Name_Type := "AdaFileName"; 69 File_Counter : Integer := 0; 70 71 type File_Type is tagged 72 record 73 Descriptor : File_Descriptor_Type := Default_Descriptor; 74 Name : File_Name_Type := Default_Filename; 75 Acct_Access : Permission_Type := Default_Permission; 76 Mode : File_Mode_Type := Default_Mode; 77 Current_Status : File_Status_Type := Default_Status; 78 end record; 79 80 type File_Array_Type is array (1 .. Max_Files) of File_Type; 81 82 File_Table : File_Array_Type; 83 84 -- 85 86 function Get_File_Name return File_Name_Type; 87 88end CA11009_0; -- Package OS. 89 90 --=================================================================-- 91 92package body CA11009_0 is -- Package body OS. 93 94 function Get_File_Name return File_Name_Type is 95 begin 96 return (An_Ada_File_Name); -- Processing would be replace by a user 97 -- prompt in a functioning system. 98 end Get_File_Name; 99 100end CA11009_0; -- Package body OS. 101 102 --=================================================================-- 103 104package CA11009_0.CA11009_1 is -- Child Package OS.File_Manager 105 106 -- This package simulates a visible interface for the Operating System. 107 -- The actual processing performed by this routine is encapsulated 108 -- in the routines of private child package Internals, which is "withed" 109 -- by the body of this package. 110 111 procedure Create_File (Mode : in File_Mode_Type; 112 File_Key : out File_Descriptor_Type); 113 114end CA11009_0.CA11009_1; -- Child Package OS.File_Manager 115 116 --=================================================================-- 117 118-- Subprogram that performs the actual file operation is contained in a 119-- private package so that it is not accessible to any client, and can be 120-- modified/extended without requiring recompilation of the clients of the 121-- parent (since this package is "withed" by the parent body only.) 122 123 124 -- Grandchild Package OS.File_Manager.Internals 125private package CA11009_0.CA11009_1.CA11009_2 is 126 127 Initial_Permission : constant Permission_Type := User; -- Grandparent 128 Initial_Status : constant File_Status_Type := Open; -- literals. 129 Initial_Filename : constant File_Name_Type := -- Grandparent type. 130 Get_File_Name; -- Grandparent function. 131 132 function Create (Mode : File_Mode_Type) 133 return File_Descriptor_Type; -- Grandparent type. 134 135end CA11009_0.CA11009_1.CA11009_2; 136 -- Grandchild Package OS.File_Manager.Internals 137 138 --=================================================================-- 139 140 -- Grandchild Package body OS.File_Manager.Internals 141package body CA11009_0.CA11009_1.CA11009_2 is 142 143 function Next_Available_File return File_Descriptor_Type is 144 begin 145 File_Counter := File_Counter + 1; -- Grandparent object. 146 return (File_Descriptor_Type(File_Counter)); 147 end Next_Available_File; 148 ------------------------------------------------------------------------- 149 function Create (Mode : File_Mode_Type) -- Grandparent literal. 150 return File_Descriptor_Type is 151 Number : File_Descriptor_Type; -- Grandparent type. 152 begin 153 Number := Next_Available_File; 154 File_Table(Number).Descriptor := Number; -- Grandparent object. 155 File_Table(Number).Name := Initial_Filename; 156 File_Table(Number).Mode := Mode; -- Parameter. 157 File_Table(Number).Acct_Access := Initial_Permission; 158 File_Table(Number).Current_Status := Initial_Status; 159 return (Number); 160 end Create; 161 162end CA11009_0.CA11009_1.CA11009_2; 163 -- Grandchild Package body OS.File_Manager.Internals 164 165 --=================================================================-- 166 167 -- "With" of a child package 168 -- by the parent body. 169with CA11009_0.CA11009_1.CA11009_2; -- Grandchild OS.File_Manager.Internals 170 171package body CA11009_0.CA11009_1 is -- Child Package body OS.File_Manager 172 173 package Internal renames CA11009_0.CA11009_1.CA11009_2; 174 175 -- These subprograms utilize calls to subprograms contained in a private 176 -- sibling to perform the actual processing. 177 178 procedure Create_File (Mode : in File_Mode_Type; 179 File_Key : out File_Descriptor_Type) is 180 begin 181 File_Key := Internal.Create (Mode); 182 end Create_File; 183 184end CA11009_0.CA11009_1; -- Child Package body OS.File_Manager 185 186 --=================================================================-- 187 188with CA11009_0.CA11009_1; -- with Child Package OS.File_Manager 189with Report; 190 191procedure CA11009 is 192 193 package OS renames CA11009_0; 194 use OS; 195 package File_Manager renames CA11009_0.CA11009_1; 196 197 Data_Base_File_Key : File_Descriptor_Type := Default_Descriptor; 198 New_Mode : File_Mode_Type := Read_Write; 199 200begin 201 202 -- This test indicates one approach to file management. 203 -- It is not intended to demonstrate full functionality, but rather 204 -- that the use of a private child package could provide a solution 205 -- to this type of situation. 206 207 Report.Test ("CA11009", "Check that a private child package can use " & 208 "entities declared in the visible part of the " & 209 "parent unit of its parent unit"); 210 211 -- Check initial conditions of the first entry in the file table. 212 -- These are all default values provided in the declaration of the 213 -- type File_Type. 214 215 if (not (Data_Base_File_Key = Default_Descriptor)) and then 216 (((not (File_Table(1).Name = Default_Filename)) or 217 (File_Table(1).Descriptor /= Default_Descriptor)) or else 218 ((File_Table(1).Acct_Access /= Default_Permission) or 219 (not (File_Table(1).Mode = Default_Mode)) or 220 (File_Table(1).Current_Status /= Default_Status))) 221 then 222 Report.Failed ("Initial condition failure"); 223 end if; 224 225 -- Create/initialize file using the capability provided by the visible 226 -- interface to the operating system, OS.File_Manager. The actual 227 -- processing routine is contained in the private grandchild package 228 -- Internals, which utilize the components from the grandparent package. 229 230 File_Manager.Create_File (New_Mode, Data_Base_File_Key); 231 232 -- Verify that the initial conditions of the file table component have 233 -- been properly modified by the initialization function. 234 235 if not ((File_Table(1).Descriptor = Data_Base_File_Key) and then 236 (File_Table(1).Name = An_Ada_File_Name) and then 237 (File_Table(1).Acct_Access = User) and then 238 not ((File_Table(1).Mode = Default_Mode) or else 239 (File_Table(1).Current_Status = Default_Status))) 240 then 241 Report.Failed ("File creation failure"); 242 end if; 243 244 Report.Result; 245 246end CA11009; 247