| -- CA11010.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 its parent unit. |
| -- |
| -- TEST DESCRIPTION: |
| -- Declare a parent package containing private types, objects, |
| -- and functions used by the system. Declare a private child package that |
| -- uses the parent components to provide functionality to the system. |
| -- |
| -- Declare an array of files with default values for all |
| -- component fields of the files (records). Check the initial state of |
| -- a specified file for proper default values. Perform the file "creation" |
| -- (initialization), which will modify the fields of the record object. |
| -- Again verify the file object to determine whether the fields have been |
| -- reset properly. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| |
| package CA11010_0 is -- Package OS. |
| |
| type File_Descriptor_Type is private; |
| |
| Default_Descriptor : constant File_Descriptor_Type; |
| |
| function Initialize_File return File_Descriptor_Type; |
| procedure Verify_Initial_Conditions (Status : out Boolean); |
| function Final_Conditions_Valid 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; |
| 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 := " "; |
| An_Ada_File_Name : constant File_Name_Type := "AdaFileName"; |
| Max_Files : constant File_Descriptor_Type := 100; |
| |
| 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 CA11010_0; -- Package OS. |
| |
| --=================================================================-- |
| |
| -- Subprograms that perform the actual file operations are contained in a |
| -- private package so that they are not accessible to any client. |
| |
| private package CA11010_0.CA11010_1 is -- Package OS.Internals |
| |
| Private_File_Counter : Integer renames File_Counter; -- Parent priv. object. |
| |
| function Initialize |
| (File_Name : File_Name_Type := Get_File_Name; -- Parent priv. function. |
| File_Mode : File_Mode_Type := Read_Write) -- Parent priv. literal. |
| return File_Descriptor_Type; -- Parent type. |
| |
| end CA11010_0.CA11010_1; -- Package OS.Internals |
| |
| --=================================================================-- |
| |
| package body CA11010_0.CA11010_1 is -- Package body OS.Internals |
| |
| function Next_Available_File return File_Descriptor_Type is |
| begin |
| Private_File_Counter := Private_File_Counter + 1; |
| return (File_Descriptor_Type(File_Counter)); |
| end Next_Available_File; |
| ---------------------------------------------------------------- |
| function Initialize |
| (File_Name : File_Name_Type := Get_File_Name; -- Parent priv. function |
| File_Mode : File_Mode_Type := Read_Write) -- Parent priv. literal |
| return File_Descriptor_Type is -- Parent type |
| Number : File_Descriptor_Type; |
| begin |
| Number := Next_Available_File; |
| File_Table(Number).Descriptor := Number; -- Parent priv. object |
| File_Table(Number).Name := File_Name; -- Default parameter value |
| File_Table(Number).Mode := File_Mode; -- Default parameter value |
| File_Table(Number).Acct_Access := User; |
| File_Table(Number).Current_Status := Open; |
| return (Number); |
| end Initialize; |
| |
| end CA11010_0.CA11010_1; -- Package body OS.Internals |
| |
| --=================================================================-- |
| |
| with CA11010_0.CA11010_1; -- Private child package "withed" by |
| -- parent body. |
| |
| package body CA11010_0 is -- Package body OS |
| |
| function Get_File_Name return File_Name_Type is |
| begin |
| return (An_Ada_File_Name); -- If this was a real function, the user |
| end Get_File_Name; -- would be asked to input a name, or there |
| -- would be some type of similar processing. |
| |
| -- This subprogram utilizes a call to a subprogram contained in a private |
| -- child to perform the actual processing. |
| |
| function Initialize_File return File_Descriptor_Type is |
| begin |
| return (CA11010_0.CA11010_1.Initialize); -- No parameters are needed, |
| -- since defaults have been |
| -- provided. |
| end Initialize_File; |
| |
| -- |
| -- Separate subunits. |
| -- |
| |
| procedure Verify_Initial_Conditions (Status : out Boolean) is separate; |
| |
| function Final_Conditions_Valid return Boolean is separate; |
| |
| end CA11010_0; -- Package body OS |
| |
| --=================================================================-- |
| |
| separate (CA11010_0) |
| procedure Verify_Initial_Conditions (Status : out Boolean) is |
| begin |
| Status := False; |
| if (File_Table(1).Descriptor = Default_Descriptor) and then |
| (File_Table(1).Name = Default_Filename) and then |
| (File_Table(1).Acct_Access = Default_Permission) and then |
| (File_Table(1).Mode = Default_Mode) and then |
| (File_Table(1).Current_Status = Default_Status) |
| then |
| Status := True; |
| end if; |
| end Verify_Initial_Conditions; |
| |
| --=================================================================-- |
| |
| separate (CA11010_0) |
| function Final_Conditions_Valid return Boolean is |
| begin |
| if ((File_Table(1).Descriptor /= Default_Descriptor) 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 |
| return (True); |
| else |
| return (False); |
| end if; |
| end Final_Conditions_Valid; |
| |
| --=================================================================-- |
| |
| with CA11010_0; -- with Package OS. |
| with Report; |
| |
| procedure CA11010 is |
| |
| package OS renames CA11010_0; |
| |
| Ada_File_Key : OS.File_Descriptor_Type := OS.Default_Descriptor; |
| Initialization_Status : Boolean := False; |
| |
| begin |
| |
| -- This test indicates one approach to a file management operation. |
| -- It is not intended to demonstrate full functionality, but rather |
| -- that the use of a private child package can provide a solution |
| -- to a user situation, that being the implementation of certain functions |
| -- being provided in a child package, with the parent package body |
| -- utilizing these implementations. |
| |
| Report.Test ("CA11010", "Check that a private child package can use " & |
| "entities declared in the private part 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. |
| |
| OS.Verify_Initial_Conditions (Initialization_Status); |
| |
| if not Initialization_Status then |
| Report.Failed ("Initial condition failure"); |
| end if; |
| |
| -- Call the initialization function. This will result in the resetting |
| -- of the fields associated with the first entry in the File_Table (this |
| -- is the first/only call of Initialize_File). |
| -- No parameters are necessary for this call, due to the default values |
| -- provided in the private child package routine Initialize. |
| |
| Ada_File_Key := OS.Initialize_File; |
| |
| -- Verify that the initial conditions of the file table component have |
| -- been properly modified by the initialization function. |
| |
| if not OS.Final_Conditions_Valid then |
| Report.Failed ("Initialization processing failure"); |
| end if; |
| |
| Report.Result; |
| |
| end CA11010; |
