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