1-- CA11003.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 a public grandchild can utilize its ancestor unit's visible
28--      definitions.
29--
30-- TEST DESCRIPTION:
31--      Declare a public package, public child package, and public
32--      grandchild package and library unit function.  Within the
33--      grandchild package and function, make use of components that are
34--      declared in the ancestor packages, both parent and grandparent.
35--
36--      Use the following ancestral components in the grandchildren library
37--      units:
38--                       Grandparent   Parent
39--          Type              X           X
40--          Constant          X           X
41--          Object            X           X
42--          Subprogram        X           X
43--          Exception         X           X
44--
45--
46-- CHANGE HISTORY:
47--      06 Dec 94   SAIC    ACVC 2.0
48--      21 Dec 94   SAIC    Modified procedure Create_File
49--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
50--
51--!
52
53package CA11003_0 is      -- Package OS
54
55   type File_Descriptor is new Integer;
56   type File_Mode       is (Read_Only, Write_Only, Read_Write);
57
58   Null_File       : constant File_Descriptor := 0;
59   Default_Mode    : constant File_Mode       := Read_Only;
60   File_Data_Error : exception;
61
62   type File_Type is tagged
63     record
64        Descriptor : File_Descriptor := Null_File;
65        Mode       : File_Mode       := Read_Write;
66     end record;
67
68   System_File : File_Type;
69
70   function Next_Available_File return File_Descriptor;
71
72   procedure Reclaim_File_Descriptor;
73
74end CA11003_0;               -- Package OS
75
76     --=================================================================--
77
78package body CA11003_0 is    -- Package body OS
79
80   File_Count : Integer := 0;
81
82   function Next_Available_File return File_Descriptor is
83   begin
84      File_Count := File_Count + 1;
85      return (File_Descriptor(File_Count));
86   end Next_Available_File;
87   --------------------------------------------------
88   procedure Reclaim_File_Descriptor is
89   begin
90      null;                                        -- Dummy processing unit.
91   end Reclaim_File_Descriptor;
92
93end CA11003_0;                          -- Package body OS
94
95     --=================================================================--
96
97package CA11003_0.CA11003_1 is          -- Child package OS.Operations
98
99   subtype File_Length_Type is Integer range 0 .. 1000;
100   Min_File_Size : File_Length_Type := File_Length_Type'First;
101   Max_File_Size : File_Length_Type := File_Length_Type'Last;
102
103   File_Duplication_Error : exception;
104
105   type Extended_File_Type is new File_Type with private;
106
107   procedure Create_File (Mode : in     File_Mode;
108                          File :    out Extended_File_Type);
109
110   procedure Duplicate_File (Original  : in     Extended_File_Type;
111                             Duplicate :    out Extended_File_Type);
112
113private
114   type Extended_File_Type is new File_Type with
115      record
116         Blocks : File_Length_Type := Min_File_Size;
117      end record;
118
119   System_Extended_File : Extended_File_Type;
120
121end CA11003_0.CA11003_1;                -- Child Package OS.Operations
122
123     --=================================================================--
124
125package body CA11003_0.CA11003_1 is     -- Child package body OS.Operations
126
127   procedure Create_File
128     (Mode : in     File_Mode;
129      File :    out Extended_File_Type) is
130   begin
131      File.Descriptor := Next_Available_File;           -- Parent subprogram.
132      File.Mode       := Default_Mode;                  -- Parent constant.
133      File.Blocks     := Min_File_Size;
134   end Create_File;
135   --------------------------------------------------
136   procedure Duplicate_File (Original  : in     Extended_File_Type;
137                             Duplicate :    out Extended_File_Type) is
138   begin
139      Duplicate.Descriptor := Next_Available_File;      -- Parent subprogram.
140      Duplicate.Mode       := Original.Mode;
141      Duplicate.Blocks     := Original.Blocks;
142   end Duplicate_File;
143
144end CA11003_0.CA11003_1;                   -- Child package body OS.Operations
145
146     --=================================================================--
147
148-- This package contains menu selectable operations for manipulating files.
149-- This abstraction builds on the capabilities available from ancestor
150-- packages.
151
152package CA11003_0.CA11003_1.CA11003_2 is
153
154   procedure News (Mode : in     File_Mode;
155                   File :    out Extended_File_Type);
156
157   procedure Copy (Original  : in     Extended_File_Type;
158                   Duplicate :    out Extended_File_Type);
159
160   procedure Delete   (File : in Extended_File_Type);
161
162end CA11003_0.CA11003_1.CA11003_2;  -- Grandchild package OS.Operations.Menu
163
164     --=================================================================--
165
166-- Grandchild subprogram Validate
167function  CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type)
168  return Boolean;
169
170     --=================================================================--
171
172-- Grandchild subprogram Validate
173function  CA11003_0.CA11003_1.CA11003_3
174  (File : in Extended_File_Type)                            -- Parent type.
175  return Boolean is
176
177   function New_File_Validated (File : Extended_File_Type)
178       return Boolean is
179   begin
180      if (File.Descriptor > System_File.Descriptor) and     -- Grandparent
181         (File.Mode in File_Mode ) and                      -- object and type
182         not ((File.Blocks < System_Extended_File.Blocks) or
183              (File.Blocks > Max_File_Size))                -- Parent object
184      then                                                  -- and constant.
185         return True;
186      else
187         return False;
188      end if;
189   end New_File_Validated;
190
191begin
192   return (New_File_Validated (File)) and
193          (File.Descriptor /= Null_File);              -- Grandparent constant.
194
195end CA11003_0.CA11003_1.CA11003_3;      -- Grandchild subprogram Validate
196
197     --=================================================================--
198
199with CA11003_0.CA11003_1.CA11003_3;
200                                 -- Grandchild package body OS.Operations.Menu
201package body CA11003_0.CA11003_1.CA11003_2 is
202
203   procedure News (Mode : in     File_Mode;
204                   File :    out Extended_File_Type) is   -- Parent type.
205   begin
206      Create_File (Mode, File);                           -- Parent subprogram.
207      if not CA11003_0.CA11003_1.CA11003_3 (File) then
208         raise File_Data_Error;                       -- Grandparent exception.
209      end if;
210   end News;
211   --------------------------------------------------
212   procedure Copy (Original  : in     Extended_File_Type;
213                   Duplicate :    out Extended_File_Type) is
214   begin
215      Duplicate_File (Original, Duplicate);               -- Parent subprogram.
216
217      if Original.Descriptor = Duplicate.Descriptor then
218         raise File_Duplication_Error;                    -- Parent exception.
219      end if;
220
221   end Copy;
222   --------------------------------------------------
223   procedure Delete (File : in Extended_File_Type) is
224   begin
225      Reclaim_File_Descriptor;                            -- Grandparent
226   end Delete;                                            -- subprogram.
227
228end CA11003_0.CA11003_1.CA11003_2;
229
230     --=================================================================--
231
232with CA11003_0.CA11003_1.CA11003_2;  -- Grandchild Pkg OS.Operations.Menu
233with CA11003_0.CA11003_1.CA11003_3;  -- Grandchild Ftn OS.Operations.Validate
234with Report;
235
236procedure CA11003 is
237
238   package Menu renames CA11003_0.CA11003_1.CA11003_2;
239
240begin
241
242   Report.Test ("CA11003", "Check that a public grandchild can utilize " &
243                "its ancestor unit's visible definitions");
244
245   File_Processing:         -- Validate all of the capabilities contained in
246                            -- the Menu package by exercising them on specific
247                            -- files.  This will demonstrate the use of child
248                            -- and grandchild functionality based on components
249                            -- that have been declared in the
250                            -- parent/grandparent package.
251   declare
252
253      function Validate (File : CA11003_0.CA11003_1.Extended_File_Type)
254        return Boolean renames CA11003_0.CA11003_1.CA11003_3;
255
256      MacWrite_File,
257      Backup_Copy : CA11003_0.CA11003_1.Extended_File_Type;
258      MacWrite_File_Mode : CA11003_0.File_Mode := CA11003_0.Read_Write;
259
260   begin
261
262      Menu.News (MacWrite_File_Mode, MacWrite_File);
263
264      if not Validate (MacWrite_File) then
265         Report.Failed ("Incorrect initialization of files");
266      end if;
267
268      Menu.Copy (MacWrite_File, Backup_Copy);
269
270      if not (Validate (MacWrite_File) and
271              Validate (Backup_Copy))
272      then
273         Report.Failed ("Incorrect duplication of files");
274      end if;
275
276      Menu.Delete (Backup_Copy);
277
278   exception
279      when CA11003_0.File_Data_Error =>
280          Report.Failed ("Exception raised during file validation");
281      when CA11003_0.CA11003_1.File_Duplication_Error =>
282          Report.Failed ("Exception raised during file duplication");
283      when others =>
284          Report.Failed ("Unexpected exception in test procedure");
285
286   end File_Processing;
287
288   Report.Result;
289
290end CA11003;
291