OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11002.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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
 
53
package 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
 
75
end CA11002_0;                            -- Package OS.
76
 
77
     --=================================================================--
78
 
79
package 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
 
95
end CA11002_0;                            -- Package body OS.
96
 
97
     --=================================================================--
98
 
99
package 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
 
107
end CA11002_0.CA11002_1;                  -- Child package OS.Operations.
108
 
109
     --=================================================================--
110
 
111
with Report;
112
package 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
 
144
end CA11002_0.CA11002_1;                  -- Child Package body OS.Operations.
145
 
146
     --=================================================================--
147
 
148
-- Child library subprogram Convert_File_Mode specification.
149
procedure CA11002_0.CA11002_2 (File     : in out File_Type;    -- Parent type.
150
                               New_Mode : in     File_Mode);   -- Parent type.
151
 
152
 
153
     --=================================================================--
154
with Report;
155
 
156
-- Child library subprogram Convert_File_Mode body.
157
procedure CA11002_0.CA11002_2 (File     : in out File_Type;
158
                               New_Mode : in     File_Mode) is
159
begin
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;
166
end CA11002_0.CA11002_2;
167
 
168
     --=================================================================--
169
 
170
with Report;
171
with CA11002_0.CA11002_1;          -- Child package OS.Operations.
172
with CA11002_0.CA11002_2;          -- Child subprogram OS.Convert_File_Mode,
173
                                   -- Implicitly with parent, OS.
174
use CA11002_0;                     -- All user-defined operators directly
175
                                   -- visible.
176
procedure CA11002 is
177
begin
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
 
238
end CA11002;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.