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