1-- CA11002.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 child can utilize its parent unit's visible
28--      definitions.
29--
30-- TEST DESCRIPTION:
31--      Declare a parent package that contains the following: type, object,
32--      constant, exception, and subprograms.  Declare a public child unit
33--      that utilizes the components found in the visible part of its parent.
34--
35--      Demonstrate utilization of the following parent components in the
36--      child package:
37--
38--                          Parent
39--          Type              X
40--          Constant          X
41--          Object            X
42--          Subprogram        X
43--          Exception         X
44--
45--      This abstraction simulates a portion of a simple operating system.
46--
47--
48-- CHANGE HISTORY:
49--      06 Dec 94   SAIC    ACVC 2.0
50--
51--!
52
53package CA11002_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   Active_Mode  : constant File_Mode       := Read_Write;
61
62   type File_Type is
63     record
64        Descriptor : File_Descriptor := Null_File;
65        Mode       : File_Mode       := Default_Mode;
66     end record;
67
68   System_File     : File_Type;
69   File_Mode_Error : exception;
70
71   function Next_Available_File return File_Descriptor;
72
73   function Mode_Of_File (File : File_Type) return File_Mode;
74
75end CA11002_0;                            -- Package OS.
76
77     --=================================================================--
78
79package body CA11002_0 is                 -- Package body OS.
80
81   File_Count : Integer := 0;
82
83   function Next_Available_File return File_Descriptor is
84   begin
85      File_Count := File_Count + 1;
86      return (File_Descriptor(File_Count));    -- Type conversion.
87   end Next_Available_File;
88   --------------------------------------------------------------
89   function Mode_Of_File (File : File_Type) return File_Mode is
90      Mode : File_Mode := File.Mode;
91   begin
92      return (Mode);
93   end Mode_Of_File;
94
95end CA11002_0;                            -- Package body OS.
96
97     --=================================================================--
98
99package CA11002_0.CA11002_1 is            -- Child package OS.Operations.
100
101   -- Dot qualification of types, objects, etc. from parent is not required
102   -- in a child unit.
103
104   procedure Create_File (Mode : in     File_Mode:= Active_Mode;
105                          File :    out File_Type);
106
107end CA11002_0.CA11002_1;                  -- Child package OS.Operations.
108
109     --=================================================================--
110
111with Report;
112package body CA11002_0.CA11002_1 is       -- Child package body OS.Operations.
113
114   function New_File_Validated (File : File_Type)        -- Ensure that a newly
115     return Boolean is                                   -- created file has
116      Result : Boolean := False;                         -- appropriate values.
117   begin
118      if (File.Descriptor > System_File.Descriptor) and  -- Parent object.
119         (File.Mode  in  File_Mode )                     -- Parent type.
120      then
121         Result := True;
122      end if;
123
124      return (Result);
125
126   end New_File_Validated;
127   --------------------------------------------------------------
128   procedure Create_File
129     (Mode       : in     File_Mode := Active_Mode;     -- Parent constant.
130      File       :    out File_Type) is                 -- Parent type.
131
132      New_File : File_Type;
133
134   begin
135      New_File.Descriptor := Next_Available_File;       -- Parent subprogram.
136      New_File.Mode       := Mode;
137
138      if New_File_Validated (File => New_File) then
139         File := New_File;
140      end if;
141
142   end Create_File;
143
144end CA11002_0.CA11002_1;                  -- Child Package body OS.Operations.
145
146     --=================================================================--
147
148-- Child library subprogram Convert_File_Mode specification.
149procedure CA11002_0.CA11002_2 (File     : in out File_Type;    -- Parent type.
150                               New_Mode : in     File_Mode);   -- Parent type.
151
152
153     --=================================================================--
154with Report;
155
156-- Child library subprogram Convert_File_Mode body.
157procedure CA11002_0.CA11002_2 (File     : in out File_Type;
158                               New_Mode : in     File_Mode) is
159begin
160   if File.Mode = New_Mode then
161      raise File_Mode_Error;                               -- Parent exception.
162      Report.Failed ("Exception not raised in child unit");
163   else
164      File.Mode := New_Mode;
165   end if;
166end CA11002_0.CA11002_2;
167
168     --=================================================================--
169
170with Report;
171with CA11002_0.CA11002_1;          -- Child package OS.Operations.
172with CA11002_0.CA11002_2;          -- Child subprogram OS.Convert_File_Mode,
173                                   -- Implicitly with parent, OS.
174use CA11002_0;                     -- All user-defined operators directly
175                                   -- visible.
176procedure CA11002 is
177begin
178
179   Report.Test ("CA11002", "Check that a public child can utilize its " &
180                "parent unit's visible definitions");
181
182   File_Creation:                   -- This processing block will demonstrate
183                                    -- use of child package subroutine that
184                                    -- takes advantage of components declared
185                                    -- in the parent package.
186   declare
187      User_File : File_Type;
188   begin
189      CA11002_0.CA11002_1.Create_File (File => User_File); -- Default mode
190                                                           -- parameter used in
191                                                           -- this call.
192      if (User_File.Descriptor = System_File.Descriptor) or
193         (User_File.Mode       = Default_Mode)
194      then
195         Report.Failed ("Incorrect file creation");
196      end if;
197
198   end File_Creation;
199
200   --------------------------------------------------------------
201   File_Mode_Conversion:            -- This processing block will demonstrate
202                                    -- the occurrence of a (forced) exception
203                                    -- being raised in a child subprogram, and
204                                    -- propagated to the caller.  The exception
205                                    -- is handled, and the child subprogram
206                                    -- is called again, this time to perform
207                                    -- without error.
208   declare
209      procedure Convert_File_Mode (File : in out File_Type;
210        New_Mode : in File_Mode) renames CA11002_0.CA11002_2;
211      New_File : File_Type;
212   begin                               -- Raise an exception with this
213                                       -- illegal conversion operation
214                                       -- (attempt to change to current mode).
215
216      Convert_File_Mode (File     => New_File,
217                         New_Mode => Default_Mode);
218      Report.Failed ("Exception should have been raised in child unit");
219
220   exception
221      when File_Mode_Error =>          -- Perform the conversion again, this
222                                       -- time with a different file mode.
223
224         Convert_File_Mode (File     => New_File,
225                            New_Mode => CA11002_0.Active_Mode);
226
227         if New_File.Mode /= Read_Write then
228            Report.Failed ("Incorrect result from mode conversion operation");
229         end if;
230
231      when others =>
232         Report.Failed ("Unexpected exception raised in File_Mode_Conversion");
233
234   end File_Mode_Conversion;
235
236   Report.Result;
237
238end CA11002;
239