| -- CA11011.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 |
| -- private part of the parent unit of its parent unit. |
| -- |
| -- TEST DESCRIPTION: |
| -- Declare a parent package containing private 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 solution to file |
| -- management. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| package CA11011_0 is -- Package OS. |
| |
| type File_Descriptor_Type is private; |
| |
| Default_Descriptor : constant File_Descriptor_Type; |
| First_File : constant File_Descriptor_Type; |
| |
| procedure Verify_Initial_Conditions (Key : in File_Descriptor_Type; |
| Status : out Boolean); |
| |
| function Final_Conditions_Valid (Key : File_Descriptor_Type) |
| return Boolean; |
| |
| |
| private |
| |
| type File_Descriptor_Type is new Integer; |
| type File_Name_Type is new String (1 .. 11); |
| type Permission_Type is (None, User, System); |
| 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; |
| First_File : constant File_Descriptor_Type := 1; |
| 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 := " "; |
| |
| Init_Permission : constant Permission_Type := User; |
| Init_Mode : constant File_Mode_Type := Read_Write; |
| Init_Status : constant File_Status_Type := Open; |
| An_Ada_File_Name : constant File_Name_Type := "AdaFileName"; |
| |
| Max_Files : constant File_Descriptor_Type := 10; |
| |
| 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; |
| File_Counter : Integer := 0; |
| |
| -- |
| |
| function Get_File_Name return File_Name_Type; |
| |
| end CA11011_0; -- Package OS. |
| |
| --=================================================================-- |
| |
| package body CA11011_0 is -- Package body OS. |
| |
| function Get_File_Name return File_Name_Type is |
| begin |
| return (An_Ada_File_Name); |
| end Get_File_Name; |
| --------------------------------------------------------------------- |
| procedure Verify_Initial_Conditions (Key : in File_Descriptor_Type; |
| Status : out Boolean) is |
| begin |
| Status := False; |
| if (File_Table(Key).Descriptor = Default_Descriptor) and then |
| (File_Table(Key).Name = Default_Filename) and then |
| (File_Table(Key).Acct_Access = Default_Permission) and then |
| (File_Table(Key).Mode = Default_Mode) and then |
| (File_Table(Key).Current_Status = Default_Status) |
| then |
| Status := True; |
| end if; |
| end Verify_Initial_Conditions; |
| --------------------------------------------------------------------- |
| function Final_Conditions_Valid (Key : File_Descriptor_Type) |
| return Boolean is |
| begin |
| if ((File_Table(Key).Descriptor = First_File) and then |
| (File_Table(Key).Name = An_Ada_File_Name) and then |
| (File_Table(Key).Acct_Access = Init_Permission) and then |
| not ((File_Table(Key).Mode = Default_Mode) or else |
| (File_Table(Key).Current_Status = Default_Status))) |
| then |
| return (True); |
| else |
| return (False); |
| end if; |
| end Final_Conditions_Valid; |
| |
| end CA11011_0; -- Package body OS. |
| |
| --=================================================================-- |
| |
| package CA11011_0.CA11011_1 is -- Package OS.File_Manager |
| |
| procedure Create_File (File_Key : in File_Descriptor_Type); |
| |
| end CA11011_0.CA11011_1; -- Package OS.File_Manager |
| |
| --=================================================================-- |
| |
| -- The Subprogram that performs the actual file operations is contained in a |
| -- private package so that it is not accessible to any client. |
| -- Default parameters are used in most cases in the subprogram calls, since |
| -- the caller does not have visibility to these private types. |
| |
| -- Package OS.File_Manager.Internals |
| private package CA11011_0.CA11011_1.CA11011_2 is |
| |
| Private_File_Counter : Integer renames File_Counter; -- Grandparent |
| -- object. |
| procedure Create |
| (Key : in File_Descriptor_Type; |
| File_Name : in File_Name_Type := Get_File_Name; -- Grandparent |
| -- prvt type, |
| -- prvt functn. |
| File_Mode : in File_Mode_Type := Init_Mode; -- Grandparent |
| -- prvt type, |
| -- prvt const. |
| File_Access : in Permission_Type := Init_Permission; -- Grandparent |
| -- prvt type, |
| -- prvt const. |
| File_Status : in File_Status_Type := Init_Status); -- Grandparent |
| -- prvt type, |
| -- prvt const. |
| |
| end CA11011_0.CA11011_1.CA11011_2; -- Package OS.File_Manager.Internals |
| |
| --=================================================================-- |
| |
| -- Package Body OS.File_Manager.Internals |
| package body CA11011_0.CA11011_1.CA11011_2 is |
| |
| procedure Create |
| (Key : in File_Descriptor_Type; |
| File_Name : in File_Name_Type := Get_File_Name; |
| File_Mode : in File_Mode_Type := Init_Mode; |
| File_Access : in Permission_Type := Init_Permission; |
| File_Status : in File_Status_Type := Init_Status) is |
| begin |
| Private_File_Counter := Private_File_Counter + 1; |
| File_Table(Key).Descriptor := Key; -- Grandparent object. |
| File_Table(Key).Name := File_Name; |
| File_Table(Key).Mode := File_Mode; |
| File_Table(Key).Acct_Access := File_Access; |
| File_Table(Key).Current_Status := File_Status; |
| end Create; |
| |
| end CA11011_0.CA11011_1.CA11011_2; -- Package body OS.File_Manager.Internals |
| |
| --=================================================================-- |
| |
| with CA11011_0.CA11011_1.CA11011_2; -- with Child OS.File_Manager.Internals |
| |
| package body CA11011_0.CA11011_1 is -- Package body OS.File_Manager |
| |
| package Internal renames CA11011_0.CA11011_1.CA11011_2; |
| |
| -- This subprogram utilizes a call to a subprogram contained in a private |
| -- child to perform the actual processing. |
| |
| procedure Create_File (File_Key : in File_Descriptor_Type) is |
| begin |
| Internal.Create (Key => File_Key); -- Other parameters are defaults, |
| -- since they are of private types |
| -- from the parent package. |
| -- File_Descriptor_Type is private, |
| -- but declared in visible part of |
| -- parent spec. |
| end Create_File; |
| |
| end CA11011_0.CA11011_1; -- Package body OS.File_Manager |
| |
| --=================================================================-- |
| |
| with CA11011_0.CA11011_1; -- with public Child Package OS.File_Manager |
| with Report; |
| |
| procedure CA11011 is |
| |
| package OS renames CA11011_0; |
| package File_Manager renames CA11011_0.CA11011_1; |
| |
| Data_Base_File_Key : OS.File_Descriptor_Type := OS.First_File; |
| TC_Status : Boolean := False; |
| |
| begin |
| |
| -- This test indicates one approach to file management operations. |
| -- It is not intended to demonstrate full functionality, but rather |
| -- that the use of a private child package can provide a solution |
| -- to a typical user situation. |
| |
| Report.Test ("CA11011", "Check that a private child package can use " & |
| "entities declared in the private part of the " & |
| "parent unit of its parent unit"); |
| |
| OS.Verify_Initial_Conditions (Data_Base_File_Key, TC_Status); |
| |
| if not TC_Status then |
| Report.Failed ("Initial condition failure"); |
| end if; |
| |
| -- Perform file initializations. |
| |
| File_Manager.Create_File (File_Key => Data_Base_File_Key); |
| |
| TC_Status := OS.Final_Conditions_Valid (Data_Base_File_Key); |
| |
| if not TC_Status then |
| Report.Failed ("Bad status return from Create_File"); |
| end if; |
| |
| Report.Result; |
| |
| end CA11011; |
