diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11010.a')
-rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11010.a | 254 |
1 files changed, 0 insertions, 254 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11010.a b/gcc/testsuite/ada/acats/tests/ca/ca11010.a deleted file mode 100644 index b13efd79851..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11010.a +++ /dev/null @@ -1,254 +0,0 @@ --- 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; |