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