1-- CA11007.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- 26-- OBJECTIVE: 27-- Check that the private part of a grandchild library unit can 28-- utilize its grandparent unit's private definition. 29-- 30-- TEST DESCRIPTION: 31-- Declare a package, child package, and grandchild package, all 32-- with private parts in their specifications. 33-- 34-- The private part of the grandchild package will make use of components 35-- that have been declared in the private part of the grandparent 36-- specification. 37-- 38-- The child package demonstrates the extension of a parent file type 39-- into an abstraction of an analog file structure. The grandchild package 40-- extends the grandparent file type into an abstraction of a digital 41-- file structure, and provides conversion capability to/from the parent 42-- analog file structure. 43-- 44-- 45-- CHANGE HISTORY: 46-- 06 Dec 94 SAIC ACVC 2.0 47-- 48--! 49 50package CA11007_0 is -- Package File_Package 51 52 type File_Descriptor is private; 53 type File_Type is tagged private; 54 55 function Next_Available_File return File_Descriptor; 56 57private 58 59 type File_Measure_Type is range 0 .. 1000; 60 type File_Descriptor is new Integer; 61 62 Null_Measure : constant File_Measure_Type := File_Measure_Type'First; 63 Null_File : constant File_Descriptor := 0; 64 65 type File_Type is tagged 66 record 67 Descriptor : File_Descriptor := Null_File; 68 end record; 69 70end CA11007_0; -- Package File_Package 71 72 --=================================================================-- 73 74package body CA11007_0 is -- Package body File_Package 75 76 File_Count : Integer := 0; 77 78 function Next_Available_File return File_Descriptor is 79 begin 80 File_Count := File_Count + 1; 81 return File_Descriptor (File_Count); 82 end Next_Available_File; 83 84end CA11007_0; -- Package body File_Package 85 86 --=================================================================-- 87 88package CA11007_0.CA11007_1 is -- Child package Analog 89 90 type Analog_File_Type is new File_Type with private; 91 92private 93 94 type Wavelength_Type is new File_Measure_Type; 95 96 Min_Wavelength : constant Wavelength_Type := Wavelength_Type'First; 97 98 type Analog_File_Type is new File_Type with -- Parent type. 99 record 100 Wavelength : Wavelength_Type := Min_Wavelength; 101 end record; 102 103end CA11007_0.CA11007_1; -- Child package Analog 104 105 --=================================================================-- 106 107package CA11007_0.CA11007_1.CA11007_2 is -- Grandchild package Digital 108 109 type Digital_File_Type is new File_Type with private; 110 111 procedure Recording (File : out Digital_File_Type); 112 113 procedure Convert (From : in Analog_File_Type; 114 To : out Digital_File_Type); 115 116 function Validate (File : in Digital_File_Type) return Boolean; 117 function Valid_Conversion (To : Digital_File_Type) return Boolean; 118 function Valid_Initial (From : Analog_File_Type) return Boolean; 119 120private 121 122 type Track_Type is new File_Measure_Type; -- Grandparent type. 123 124 Min_Tracks : constant Track_Type := 125 Track_Type (Null_Measure) + Track_Type'First; -- Grandparent private 126 Max_Tracks : constant Track_Type := -- constant. 127 Track_Type (Null_Measure) + Track_Type'Last; 128 129 type Digital_File_Type is new File_Type with -- Grandparent type. 130 record 131 Tracks : Track_Type := Min_Tracks; 132 end record; 133 134end CA11007_0.CA11007_1.CA11007_2; -- Grandchild package Digital 135 136 --=================================================================-- 137 138 -- Grandchild package body Digital 139package body CA11007_0.CA11007_1.CA11007_2 is 140 141 procedure Recording (File : out Digital_File_Type) is 142 begin 143 File.Descriptor := Next_Available_File; -- Assign new file descriptor. 144 File.Tracks := Max_Tracks; -- Change initial value. 145 end Recording; 146 -------------------------------------------------------------------------- 147 procedure Convert (From : in Analog_File_Type; 148 To : out Digital_File_Type) is 149 begin 150 To.Descriptor := From.Descriptor + 100; -- Dummy conversion. 151 To.Tracks := Track_Type (From.Wavelength) / 2; 152 end Convert; 153 -------------------------------------------------------------------------- 154 function Validate (File : in Digital_File_Type) return Boolean is 155 Result : Boolean := False; 156 begin 157 if not (File.Tracks /= Max_Tracks) then 158 Result := True; 159 end if; 160 return Result; 161 end Validate; 162 -------------------------------------------------------------------------- 163 function Valid_Conversion (To : Digital_File_Type) return Boolean is 164 begin 165 return (To.Descriptor = 100) and (To.Tracks = (Min_Tracks / 2)); 166 end Valid_Conversion; 167 -------------------------------------------------------------------------- 168 function Valid_Initial (From : Analog_File_Type) return Boolean is 169 begin 170 return (From.Wavelength = Min_Wavelength); -- Validate initial 171 end Valid_Initial; -- conditions. 172 173end CA11007_0.CA11007_1.CA11007_2; -- Grandchild package body Digital 174 175 --=================================================================-- 176 177with CA11007_0.CA11007_1.CA11007_2; -- with Grandchild package Digital 178with Report; 179 180procedure CA11007 is 181 182 package Analog renames CA11007_0.CA11007_1; 183 package Digital renames CA11007_0.CA11007_1.CA11007_2; 184 185 Original_Digital_File, 186 Converted_Digital_File : Digital.Digital_File_Type; 187 188 Original_Analog_File : Analog.Analog_File_Type; 189 190begin 191 192 -- This code demonstrates how private extensions could be utilized 193 -- in child packages to allow for recording on different media. 194 -- The processing contained in the procedures and functions is 195 -- "dummy" processing, not intended to perform actual recording, 196 -- conversion, or validation operations, but simply to demonstrate 197 -- this type of structural decomposition as a possible solution to 198 -- a user's design problem. 199 200 Report.Test ("CA11007", "Check that the private part of a grandchild " & 201 "library unit can utilize its grandparent " & 202 "unit's private definition"); 203 204 if not Digital.Valid_Initial (Original_Analog_File) 205 then 206 Report.Failed ("Incorrect initialization of Analog File"); 207 end if; 208 209 --- 210 211 Digital.Convert (From => Original_Analog_File, -- Convert file to 212 To => Converted_Digital_File); -- digital format. 213 214 if not Digital.Valid_Conversion (To => Converted_Digital_File) then 215 Report.Failed ("Incorrect conversion of analog file"); 216 end if; 217 218 --- 219 220 Digital.Recording (Original_Digital_File); -- Create file in 221 -- digital format. 222 if not Digital.Validate (Original_Digital_File) then 223 Report.Failed ("Incorrect recording of digital file"); 224 end if; 225 226 Report.Result; 227 228end CA11007; 229