diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11007.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11007.a | 228 |
1 files changed, 0 insertions, 228 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11007.a b/gcc/testsuite/ada/acats/tests/ca/ca11007.a deleted file mode 100644 index c4a6789ab8e..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11007.a +++ /dev/null @@ -1,228 +0,0 @@ --- CA11007.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 the private part of a grandchild library unit can --- utilize its grandparent unit's private definition. --- --- TEST DESCRIPTION: --- Declare a package, child package, and grandchild package, all --- with private parts in their specifications. --- --- The private part of the grandchild package will make use of components --- that have been declared in the private part of the grandparent --- specification. --- --- The child package demonstrates the extension of a parent file type --- into an abstraction of an analog file structure. The grandchild package --- extends the grandparent file type into an abstraction of a digital --- file structure, and provides conversion capability to/from the parent --- analog file structure. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -package CA11007_0 is -- Package File_Package - - type File_Descriptor is private; - type File_Type is tagged private; - - function Next_Available_File return File_Descriptor; - -private - - type File_Measure_Type is range 0 .. 1000; - type File_Descriptor is new Integer; - - Null_Measure : constant File_Measure_Type := File_Measure_Type'First; - Null_File : constant File_Descriptor := 0; - - type File_Type is tagged - record - Descriptor : File_Descriptor := Null_File; - end record; - -end CA11007_0; -- Package File_Package - - --=================================================================-- - -package body CA11007_0 is -- Package body File_Package - - File_Count : Integer := 0; - - function Next_Available_File return File_Descriptor is - begin - File_Count := File_Count + 1; - return File_Descriptor (File_Count); - end Next_Available_File; - -end CA11007_0; -- Package body File_Package - - --=================================================================-- - -package CA11007_0.CA11007_1 is -- Child package Analog - - type Analog_File_Type is new File_Type with private; - -private - - type Wavelength_Type is new File_Measure_Type; - - Min_Wavelength : constant Wavelength_Type := Wavelength_Type'First; - - type Analog_File_Type is new File_Type with -- Parent type. - record - Wavelength : Wavelength_Type := Min_Wavelength; - end record; - -end CA11007_0.CA11007_1; -- Child package Analog - - --=================================================================-- - -package CA11007_0.CA11007_1.CA11007_2 is -- Grandchild package Digital - - type Digital_File_Type is new File_Type with private; - - procedure Recording (File : out Digital_File_Type); - - procedure Convert (From : in Analog_File_Type; - To : out Digital_File_Type); - - function Validate (File : in Digital_File_Type) return Boolean; - function Valid_Conversion (To : Digital_File_Type) return Boolean; - function Valid_Initial (From : Analog_File_Type) return Boolean; - -private - - type Track_Type is new File_Measure_Type; -- Grandparent type. - - Min_Tracks : constant Track_Type := - Track_Type (Null_Measure) + Track_Type'First; -- Grandparent private - Max_Tracks : constant Track_Type := -- constant. - Track_Type (Null_Measure) + Track_Type'Last; - - type Digital_File_Type is new File_Type with -- Grandparent type. - record - Tracks : Track_Type := Min_Tracks; - end record; - -end CA11007_0.CA11007_1.CA11007_2; -- Grandchild package Digital - - --=================================================================-- - - -- Grandchild package body Digital -package body CA11007_0.CA11007_1.CA11007_2 is - - procedure Recording (File : out Digital_File_Type) is - begin - File.Descriptor := Next_Available_File; -- Assign new file descriptor. - File.Tracks := Max_Tracks; -- Change initial value. - end Recording; - -------------------------------------------------------------------------- - procedure Convert (From : in Analog_File_Type; - To : out Digital_File_Type) is - begin - To.Descriptor := From.Descriptor + 100; -- Dummy conversion. - To.Tracks := Track_Type (From.Wavelength) / 2; - end Convert; - -------------------------------------------------------------------------- - function Validate (File : in Digital_File_Type) return Boolean is - Result : Boolean := False; - begin - if not (File.Tracks /= Max_Tracks) then - Result := True; - end if; - return Result; - end Validate; - -------------------------------------------------------------------------- - function Valid_Conversion (To : Digital_File_Type) return Boolean is - begin - return (To.Descriptor = 100) and (To.Tracks = (Min_Tracks / 2)); - end Valid_Conversion; - -------------------------------------------------------------------------- - function Valid_Initial (From : Analog_File_Type) return Boolean is - begin - return (From.Wavelength = Min_Wavelength); -- Validate initial - end Valid_Initial; -- conditions. - -end CA11007_0.CA11007_1.CA11007_2; -- Grandchild package body Digital - - --=================================================================-- - -with CA11007_0.CA11007_1.CA11007_2; -- with Grandchild package Digital -with Report; - -procedure CA11007 is - - package Analog renames CA11007_0.CA11007_1; - package Digital renames CA11007_0.CA11007_1.CA11007_2; - - Original_Digital_File, - Converted_Digital_File : Digital.Digital_File_Type; - - Original_Analog_File : Analog.Analog_File_Type; - -begin - - -- This code demonstrates how private extensions could be utilized - -- in child packages to allow for recording on different media. - -- The processing contained in the procedures and functions is - -- "dummy" processing, not intended to perform actual recording, - -- conversion, or validation operations, but simply to demonstrate - -- this type of structural decomposition as a possible solution to - -- a user's design problem. - - Report.Test ("CA11007", "Check that the private part of a grandchild " & - "library unit can utilize its grandparent " & - "unit's private definition"); - - if not Digital.Valid_Initial (Original_Analog_File) - then - Report.Failed ("Incorrect initialization of Analog File"); - end if; - - --- - - Digital.Convert (From => Original_Analog_File, -- Convert file to - To => Converted_Digital_File); -- digital format. - - if not Digital.Valid_Conversion (To => Converted_Digital_File) then - Report.Failed ("Incorrect conversion of analog file"); - end if; - - --- - - Digital.Recording (Original_Digital_File); -- Create file in - -- digital format. - if not Digital.Validate (Original_Digital_File) then - Report.Failed ("Incorrect recording of digital file"); - end if; - - Report.Result; - -end CA11007; |