-- CA11009.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that a private child package can use entities declared in the -- visible part of the parent unit of its parent unit. -- -- TEST DESCRIPTION: -- Declare a parent package containing types and objects used by the -- system. Declare a public child package that provides a visible -- interface to the system functionality. -- Declare a private grandchild package that uses the visible grandparent -- components to provide the actual functionality to the system. -- -- The public child (parent of the private grandchild) uses the -- functionality of its private child (grandchild package) to provide -- the visible interface to operations of the system. -- -- The test itself will utilize the visible interface provided in the -- public child package to demonstrate a possible structure for -- file management. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 15 Apr 96 SAIC ACVC 2.1: Added pragma Elaborate_body. -- --! package CA11009_0 is -- Package OS. pragma Elaborate_Body (CA11009_0); type File_Descriptor_Type is new Integer; type File_Name_Type is new String (1 .. 11); type Permission_Type is (None, User, System, Bypass); type File_Mode_Type is (Read_Only, Write_Only, Read_Write); type File_Status_Type is (Open, Closed); Default_Descriptor : constant File_Descriptor_Type := 0; Default_Permission : constant Permission_Type := None; Default_Mode : constant File_Mode_Type := Read_Only; Default_Status : constant File_Status_Type := Closed; Default_Filename : constant File_Name_Type := " "; Max_Files : constant File_Descriptor_Type := 10; An_Ada_File_Name : constant File_Name_Type := "AdaFileName"; File_Counter : Integer := 0; type File_Type is tagged record Descriptor : File_Descriptor_Type := Default_Descriptor; Name : File_Name_Type := Default_Filename; Acct_Access : Permission_Type := Default_Permission; Mode : File_Mode_Type := Default_Mode; Current_Status : File_Status_Type := Default_Status; end record; type File_Array_Type is array (1 .. Max_Files) of File_Type; File_Table : File_Array_Type; -- function Get_File_Name return File_Name_Type; end CA11009_0; -- Package OS. --=================================================================-- package body CA11009_0 is -- Package body OS. function Get_File_Name return File_Name_Type is begin return (An_Ada_File_Name); -- Processing would be replace by a user -- prompt in a functioning system. end Get_File_Name; end CA11009_0; -- Package body OS. --=================================================================-- package CA11009_0.CA11009_1 is -- Child Package OS.File_Manager -- This package simulates a visible interface for the Operating System. -- The actual processing performed by this routine is encapsulated -- in the routines of private child package Internals, which is "withed" -- by the body of this package. procedure Create_File (Mode : in File_Mode_Type; File_Key : out File_Descriptor_Type); end CA11009_0.CA11009_1; -- Child Package OS.File_Manager --=================================================================-- -- Subprogram that performs the actual file operation is contained in a -- private package so that it is not accessible to any client, and can be -- modified/extended without requiring recompilation of the clients of the -- parent (since this package is "withed" by the parent body only.) -- Grandchild Package OS.File_Manager.Internals private package CA11009_0.CA11009_1.CA11009_2 is Initial_Permission : constant Permission_Type := User; -- Grandparent Initial_Status : constant File_Status_Type := Open; -- literals. Initial_Filename : constant File_Name_Type := -- Grandparent type. Get_File_Name; -- Grandparent function. function Create (Mode : File_Mode_Type) return File_Descriptor_Type; -- Grandparent type. end CA11009_0.CA11009_1.CA11009_2; -- Grandchild Package OS.File_Manager.Internals --=================================================================-- -- Grandchild Package body OS.File_Manager.Internals package body CA11009_0.CA11009_1.CA11009_2 is function Next_Available_File return File_Descriptor_Type is begin File_Counter := File_Counter + 1; -- Grandparent object. return (File_Descriptor_Type(File_Counter)); end Next_Available_File; ------------------------------------------------------------------------- function Create (Mode : File_Mode_Type) -- Grandparent literal. return File_Descriptor_Type is Number : File_Descriptor_Type; -- Grandparent type. begin Number := Next_Available_File; File_Table(Number).Descriptor := Number; -- Grandparent object. File_Table(Number).Name := Initial_Filename; File_Table(Number).Mode := Mode; -- Parameter. File_Table(Number).Acct_Access := Initial_Permission; File_Table(Number).Current_Status := Initial_Status; return (Number); end Create; end CA11009_0.CA11009_1.CA11009_2; -- Grandchild Package body OS.File_Manager.Internals --=================================================================-- -- "With" of a child package -- by the parent body. with CA11009_0.CA11009_1.CA11009_2; -- Grandchild OS.File_Manager.Internals package body CA11009_0.CA11009_1 is -- Child Package body OS.File_Manager package Internal renames CA11009_0.CA11009_1.CA11009_2; -- These subprograms utilize calls to subprograms contained in a private -- sibling to perform the actual processing. procedure Create_File (Mode : in File_Mode_Type; File_Key : out File_Descriptor_Type) is begin File_Key := Internal.Create (Mode); end Create_File; end CA11009_0.CA11009_1; -- Child Package body OS.File_Manager --=================================================================-- with CA11009_0.CA11009_1; -- with Child Package OS.File_Manager with Report; procedure CA11009 is package OS renames CA11009_0; use OS; package File_Manager renames CA11009_0.CA11009_1; Data_Base_File_Key : File_Descriptor_Type := Default_Descriptor; New_Mode : File_Mode_Type := Read_Write; begin -- This test indicates one approach to file management. -- It is not intended to demonstrate full functionality, but rather -- that the use of a private child package could provide a solution -- to this type of situation. Report.Test ("CA11009", "Check that a private child package can use " & "entities declared in the visible part of the " & "parent unit of its parent unit"); -- Check initial conditions of the first entry in the file table. -- These are all default values provided in the declaration of the -- type File_Type. if (not (Data_Base_File_Key = Default_Descriptor)) and then (((not (File_Table(1).Name = Default_Filename)) or (File_Table(1).Descriptor /= Default_Descriptor)) or else ((File_Table(1).Acct_Access /= Default_Permission) or (not (File_Table(1).Mode = Default_Mode)) or (File_Table(1).Current_Status /= Default_Status))) then Report.Failed ("Initial condition failure"); end if; -- Create/initialize file using the capability provided by the visible -- interface to the operating system, OS.File_Manager. The actual -- processing routine is contained in the private grandchild package -- Internals, which utilize the components from the grandparent package. File_Manager.Create_File (New_Mode, Data_Base_File_Key); -- Verify that the initial conditions of the file table component have -- been properly modified by the initialization function. if not ((File_Table(1).Descriptor = Data_Base_File_Key) and then (File_Table(1).Name = An_Ada_File_Name) and then (File_Table(1).Acct_Access = User) and then not ((File_Table(1).Mode = Default_Mode) or else (File_Table(1).Current_Status = Default_Status))) then Report.Failed ("File creation failure"); end if; Report.Result; end CA11009;