| -- 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; |
