| -- CA11008.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 its parent unit. |
| -- |
| -- TEST DESCRIPTION: |
| -- Declare a parent package containing types and objects used |
| -- by the system. Declare a private child package that uses the parent |
| -- components to provide functionality to the system. |
| -- |
| -- The tagged file type defined in the parent has defaults for all |
| -- component fields. Prior to initialization, these values are checked |
| -- to ensure a correct start condition. The initial subprogram is |
| -- called, which utilizes the functionality provided in the private |
| -- child package. This subprogram changes the fields of the file object |
| -- to something other than the default values, and this process is then |
| -- verified at the conclusion of the test. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| package CA11008_0 is -- Package OS. |
| |
| 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 := 100; |
| Constant_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; |
| |
| function Initialize_File return File_Descriptor_Type; |
| |
| end CA11008_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 CA11008_0.CA11008_1 is -- Package OS.Internals |
| |
| Private_File_Counter : Integer renames File_Counter; -- Parent |
| -- object. |
| function Initialize |
| (File_Name : File_Name_Type := Get_File_Name; -- Parent function. |
| File_Mode : File_Mode_Type := Read_Write) -- Parent literal. |
| return File_Descriptor_Type; -- Parent type. |
| |
| end CA11008_0.CA11008_1; -- Package OS.Internals |
| |
| --=================================================================-- |
| |
| package body CA11008_0.CA11008_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 function |
| File_Mode : File_Mode_Type := Read_Write) -- Parent literal |
| return File_Descriptor_Type is -- Parent type |
| Number : File_Descriptor_Type; |
| begin |
| Number := Next_Available_File; |
| File_Table(Number).Descriptor := Number; -- Parent 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 CA11008_0.CA11008_1; -- Package body OS.Internals |
| |
| --=================================================================-- |
| |
| with CA11008_0.CA11008_1; -- Private child package "withed" by |
| -- parent body. |
| |
| package body CA11008_0 is -- Package body OS |
| |
| function Get_File_Name return File_Name_Type is |
| begin |
| return (Constant_Name); -- Of course if this was a real function, the |
| end Get_File_Name; -- user would be asked to input a name, or |
| -- there would be some type of similar process. |
| |
| -- 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 (CA11008_0.CA11008_1.Initialize); -- No parameters are needed, |
| -- since defaults have been |
| -- provided. |
| end Initialize_File; |
| |
| end CA11008_0; -- Package body OS |
| |
| --=================================================================-- |
| |
| with CA11008_0; -- with Package OS. |
| with Report; |
| |
| procedure CA11008 is |
| |
| package OS renames CA11008_0; |
| use OS; |
| Ada_File_Key : File_Descriptor_Type := Default_Descriptor; |
| |
| 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 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 ("CA11008", "Check that a private child package can use " & |
| "entities declared in the visible 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. |
| |
| if (Ada_File_Key /= Default_Descriptor) or else |
| (File_Table(1).Descriptor /= (Default_Descriptor) or |
| (File_Table(1).Name /= Default_Filename)) or else |
| (File_Table(1).Acct_Access /= (Default_Permission) or |
| (File_Table(1).Mode /= Default_Mode)) or else |
| (File_Table(1).Current_Status /= Default_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 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 := Initialize_File; |
| |
| -- Verify that the initial conditions of the file table component have |
| -- been properly modified by the initialization function. |
| |
| if not ((File_Table(1).Descriptor = Ada_File_Key) and then |
| (File_Table(1).Name = Constant_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 ("Initialization processing failure"); |
| end if; |
| |
| Report.Result; |
| |
| end CA11008; |
