3 -- Grant of Unlimited Rights
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
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.
27 -- Check that the private part of a grandchild library unit can
28 -- utilize its grandparent unit's private definition.
31 -- Declare a package, child package, and grandchild package, all
32 -- with private parts in their specifications.
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
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.
46 -- 06 Dec 94 SAIC ACVC 2.0
50 package CA11007_0
is -- Package File_Package
52 type File_Descriptor
is private;
53 type File_Type
is tagged private;
55 function Next_Available_File
return File_Descriptor
;
59 type File_Measure_Type
is range 0 .. 1000;
60 type File_Descriptor
is new Integer;
62 Null_Measure
: constant File_Measure_Type
:= File_Measure_Type
'First;
63 Null_File
: constant File_Descriptor
:= 0;
65 type File_Type
is tagged
67 Descriptor
: File_Descriptor
:= Null_File
;
70 end CA11007_0
; -- Package File_Package
72 --=================================================================--
74 package body CA11007_0
is -- Package body File_Package
76 File_Count
: Integer := 0;
78 function Next_Available_File
return File_Descriptor
is
80 File_Count
:= File_Count
+ 1;
81 return File_Descriptor
(File_Count
);
82 end Next_Available_File
;
84 end CA11007_0
; -- Package body File_Package
86 --=================================================================--
88 package CA11007_0
.CA11007_1
is -- Child package Analog
90 type Analog_File_Type
is new File_Type
with private;
94 type Wavelength_Type
is new File_Measure_Type
;
96 Min_Wavelength
: constant Wavelength_Type
:= Wavelength_Type
'First;
98 type Analog_File_Type
is new File_Type
with -- Parent type.
100 Wavelength
: Wavelength_Type
:= Min_Wavelength
;
103 end CA11007_0
.CA11007_1
; -- Child package Analog
105 --=================================================================--
107 package CA11007_0
.CA11007_1
.CA11007_2
is -- Grandchild package Digital
109 type Digital_File_Type
is new File_Type
with private;
111 procedure Recording
(File
: out Digital_File_Type
);
113 procedure Convert
(From
: in Analog_File_Type
;
114 To
: out Digital_File_Type
);
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;
122 type Track_Type
is new File_Measure_Type
; -- Grandparent type.
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;
129 type Digital_File_Type
is new File_Type
with -- Grandparent type.
131 Tracks
: Track_Type
:= Min_Tracks
;
134 end CA11007_0
.CA11007_1
.CA11007_2
; -- Grandchild package Digital
136 --=================================================================--
138 -- Grandchild package body Digital
139 package body CA11007_0
.CA11007_1
.CA11007_2
is
141 procedure Recording
(File
: out Digital_File_Type
) is
143 File
.Descriptor
:= Next_Available_File
; -- Assign new file descriptor.
144 File
.Tracks
:= Max_Tracks
; -- Change initial value.
146 --------------------------------------------------------------------------
147 procedure Convert
(From
: in Analog_File_Type
;
148 To
: out Digital_File_Type
) is
150 To
.Descriptor
:= From
.Descriptor
+ 100; -- Dummy conversion.
151 To
.Tracks
:= Track_Type
(From
.Wavelength
) / 2;
153 --------------------------------------------------------------------------
154 function Validate
(File
: in Digital_File_Type
) return Boolean is
155 Result
: Boolean := False;
157 if not (File
.Tracks
/= Max_Tracks
) then
162 --------------------------------------------------------------------------
163 function Valid_Conversion
(To
: Digital_File_Type
) return Boolean is
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
170 return (From
.Wavelength
= Min_Wavelength
); -- Validate initial
171 end Valid_Initial
; -- conditions.
173 end CA11007_0
.CA11007_1
.CA11007_2
; -- Grandchild package body Digital
175 --=================================================================--
177 with CA11007_0
.CA11007_1
.CA11007_2
; -- with Grandchild package Digital
182 package Analog
renames CA11007_0
.CA11007_1
;
183 package Digital
renames CA11007_0
.CA11007_1
.CA11007_2
;
185 Original_Digital_File
,
186 Converted_Digital_File
: Digital
.Digital_File_Type
;
188 Original_Analog_File
: Analog
.Analog_File_Type
;
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.
200 Report
.Test
("CA11007", "Check that the private part of a grandchild " &
201 "library unit can utilize its grandparent " &
202 "unit's private definition");
204 if not Digital
.Valid_Initial
(Original_Analog_File
)
206 Report
.Failed
("Incorrect initialization of Analog File");
211 Digital
.Convert
(From
=> Original_Analog_File
, -- Convert file to
212 To
=> Converted_Digital_File
); -- digital format.
214 if not Digital
.Valid_Conversion
(To
=> Converted_Digital_File
) then
215 Report
.Failed
("Incorrect conversion of analog file");
220 Digital
.Recording
(Original_Digital_File
); -- Create file in
222 if not Digital
.Validate
(Original_Digital_File
) then
223 Report
.Failed
("Incorrect recording of digital file");