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