1-- CA11006.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 child library unit can utilize
28--      its parent unit's private definition.
29--
30-- TEST DESCRIPTION:
31--      Declare a package and public child package, both with private
32--      parts.  The child package will have a private extension of a type
33--      declared in the parent's private part.  In addition, the private
34--      part of the child package specification will make use of some of
35--      the components declared in the private part of the parent.
36--
37--
38-- CHANGE HISTORY:
39--      06 Dec 94   SAIC    ACVC 2.0
40--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
41--
42--!
43
44package CA11006_0 is      -- Package File_Package
45
46   type File_Descriptor is private;
47   type File_Mode       is (Read_Only, Write_Only, Read_Write);
48   type File_Type       is tagged private;
49
50   function  Next_Available_File return File_Descriptor;
51
52private
53
54   type File_Measure    is range 0 .. 1000;
55   type File_Descriptor is new Integer;
56
57   Null_File       : constant File_Descriptor := 0;
58   Default_Mode    : constant File_Mode       := Read_Write;
59
60   type File_Type is tagged
61     record
62        Descriptor : File_Descriptor := Null_File;
63        Mode       : File_Mode       := Default_Mode;
64     end record;
65
66   System_File : File_Type;
67
68end CA11006_0;               -- Package File_Package
69
70     --=================================================================--
71
72package body CA11006_0 is    -- Package File_Package
73
74   File_Count : Integer := 0;
75
76   function Next_Available_File return File_Descriptor is
77   begin
78      File_Count := File_Count + 1;
79      return File_Descriptor (File_Count);
80   end Next_Available_File;
81
82end CA11006_0;               -- Package File_Package
83
84     --=================================================================--
85
86package CA11006_0.CA11006_1 is        -- Child package File_Package.Operations
87
88   type File_Length_Type   is private;
89   type Extended_File_Type is new File_Type with private;
90
91   System_Extended_File : constant Extended_File_Type;
92
93   procedure Create_File (Mode : in     File_Mode;
94                          File :    out Extended_File_Type);
95
96   procedure Compress_File (Original        : in     Extended_File_Type;
97                            Compressed_File :    out Extended_File_Type);
98
99   function  Validate (File : in Extended_File_Type) return Boolean;
100
101   function  Validate_Compression (File : in Extended_File_Type)
102     return Boolean;
103                                   -- These two validation functions provide
104                                   -- the capability to check the private
105                                   -- components defined in the parent and
106                                   -- child packages from within the client
107                                   -- program.
108private
109
110   type File_Length_Type is new File_Measure;       -- Parent private type.
111
112   Min_File_Size : File_Length_Type := File_Length_Type'First;
113   Max_File_Size : File_Length_Type := File_Length_Type'Last;
114
115   type Extended_File_Type is new File_Type with        -- Parent type.
116      record
117         Blocks : File_Length_Type := Min_File_Size;
118      end record;
119
120   System_Extended_File : constant Extended_File_Type :=
121     (Descriptor => System_File.Descriptor,      -- Parent private object.
122      Mode       => Read_Only,                   -- Parent enumeration literal.
123      Blocks     => Min_File_Size);
124
125
126end CA11006_0.CA11006_1;             -- Child Package File_Package.Operations
127
128     --=================================================================--
129
130                                -- Child package body File_Package.Operations
131package body CA11006_0.CA11006_1 is
132
133   procedure Create_File
134     (Mode : in     File_Mode;
135      File :    out Extended_File_Type) is
136   begin
137      File.Descriptor := Next_Available_File;    -- Parent subprogram.
138      File.Mode       := Default_Mode;           -- Parent private constant.
139      File.Blocks     := Max_File_Size;
140   end Create_File;
141   ------------------------------------------------------------------------
142   procedure Compress_File (Original        : in     Extended_File_Type;
143                            Compressed_File :    out Extended_File_Type) is
144   begin
145      Compressed_File.Descriptor := Next_Available_File;
146      Compressed_File.Mode       := Read_Only;
147      Compressed_File.Blocks     := Original.Blocks / 2;  -- Simulated file
148   end Compress_File;                                     -- compression.
149   ------------------------------------------------------------------------
150   function  Validate (File : in Extended_File_Type) return Boolean is
151   begin
152      if ((File.Descriptor /= System_Extended_File.Descriptor) and
153          (File.Mode = Read_Write)                             and
154          (File.Blocks = Max_File_Size))                       then
155         return True;
156      else
157         return False;
158      end if;
159   end Validate;
160   ------------------------------------------------------------------------
161   function  Validate_Compression (File : in Extended_File_Type)
162      return Boolean is
163   begin
164      if ((File.Descriptor /= System_File.Descriptor) and
165          (File.Mode = Read_Only)                     and
166          (File.Blocks = Max_File_Size/2))            then
167         return True;
168      else
169         return False;
170      end if;
171   end Validate_Compression;
172
173end CA11006_0.CA11006_1;         -- Child package body File_Package.Operations
174
175     --=================================================================--
176
177with CA11006_0.CA11006_1;        -- with Child package File_Package.Operations
178with Report;
179
180procedure CA11006 is
181
182   package File      renames CA11006_0;
183   package File_Ops  renames CA11006_0.CA11006_1;
184
185   Validation_File_Mode : File.File_Mode := File.Read_Only;
186   Validation_File,
187   Storage_Copy         : File_Ops.Extended_File_Type;
188
189begin
190
191   Report.Test ("CA11006", "Check that the private part of a child "  &
192                           "library unit can utilize its parent "     &
193                           "unit's private definition");
194
195   File_Ops.Create_File (Validation_File_Mode, Validation_File);
196
197   if not File_Ops.Validate (Validation_File) then
198      Report.Failed ("Incorrect initialization of file");
199   end if;
200
201   File_Ops.Compress_File (Validation_File, Storage_Copy);
202
203   if not (File_Ops.Validate (Validation_File) and
204           File_Ops.Validate_Compression (Storage_Copy))
205   then
206      Report.Failed ("Incorrect compression of file");
207   end if;
208
209   Report.Result;
210
211end CA11006;
212