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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11009.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA11009.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 private child package can use entities declared in the
28
--      visible part of the parent unit of its parent unit.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a parent package containing types and objects used by the
32
--      system.  Declare a public child package that provides a visible
33
--      interface to the system functionality.
34
--      Declare a private grandchild package that uses the visible grandparent
35
--      components to provide the actual functionality to the system.
36
--
37
--      The public child (parent of the private grandchild) uses the
38
--      functionality of its private child (grandchild package) to provide
39
--      the visible interface to operations of the system.
40
--
41
--      The test itself will utilize the visible interface provided in the
42
--      public child package to demonstrate a possible structure for
43
--      file management.
44
--
45
--
46
-- CHANGE HISTORY:
47
--      06 Dec 94   SAIC    ACVC 2.0
48
--      15 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate_body.
49
--
50
--!
51
 
52
package CA11009_0 is               -- Package OS.
53
   pragma Elaborate_Body (CA11009_0);
54
 
55
   type File_Descriptor_Type is new Integer;
56
   type File_Name_Type       is new String (1 .. 11);
57
   type Permission_Type      is (None, User, System, Bypass);
58
   type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
59
   type File_Status_Type     is (Open, Closed);
60
 
61
   Default_Descriptor : constant File_Descriptor_Type := 0;
62
   Default_Permission : constant Permission_Type      := None;
63
   Default_Mode       : constant File_Mode_Type       := Read_Only;
64
   Default_Status     : constant File_Status_Type     := Closed;
65
   Default_Filename   : constant File_Name_Type       := "           ";
66
 
67
   Max_Files          : constant File_Descriptor_Type := 10;
68
   An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
69
   File_Counter       : Integer                       := 0;
70
 
71
   type File_Type is tagged
72
      record
73
         Descriptor     : File_Descriptor_Type := Default_Descriptor;
74
         Name           : File_Name_Type       := Default_Filename;
75
         Acct_Access    : Permission_Type      := Default_Permission;
76
         Mode           : File_Mode_Type       := Default_Mode;
77
         Current_Status : File_Status_Type     := Default_Status;
78
      end record;
79
 
80
   type File_Array_Type is array (1 .. Max_Files) of File_Type;
81
 
82
   File_Table : File_Array_Type;
83
 
84
   --
85
 
86
   function Get_File_Name return File_Name_Type;
87
 
88
end CA11009_0;                     -- Package OS.
89
 
90
     --=================================================================--
91
 
92
package body CA11009_0 is          -- Package body OS.
93
 
94
   function Get_File_Name return File_Name_Type is
95
   begin
96
      return (An_Ada_File_Name);   -- Processing would be replace by a user
97
                                   -- prompt in a functioning system.
98
   end Get_File_Name;
99
 
100
end CA11009_0;                     -- Package body OS.
101
 
102
     --=================================================================--
103
 
104
package CA11009_0.CA11009_1 is     -- Child Package OS.File_Manager
105
 
106
   -- This package simulates a visible interface for the Operating System.
107
   -- The actual processing performed by this routine is encapsulated
108
   -- in the routines of private child package Internals, which is "withed"
109
   -- by the body of this package.
110
 
111
   procedure Create_File (Mode      : in     File_Mode_Type;
112
                          File_Key  :    out File_Descriptor_Type);
113
 
114
end CA11009_0.CA11009_1;           -- Child Package OS.File_Manager
115
 
116
     --=================================================================--
117
 
118
-- Subprogram that performs the actual file operation is contained in a
119
-- private package so that it is not accessible to any client, and can be
120
-- modified/extended without requiring recompilation of the clients of the
121
-- parent (since this package is "withed" by the parent body only.)
122
 
123
 
124
                               -- Grandchild Package OS.File_Manager.Internals
125
private package CA11009_0.CA11009_1.CA11009_2 is
126
 
127
   Initial_Permission : constant Permission_Type  := User;  -- Grandparent
128
   Initial_Status     : constant File_Status_Type := Open;  -- literals.
129
   Initial_Filename   : constant File_Name_Type   :=  -- Grandparent type.
130
     Get_File_Name;                                   -- Grandparent function.
131
 
132
   function Create (Mode : File_Mode_Type)
133
     return File_Descriptor_Type;                     -- Grandparent type.
134
 
135
end CA11009_0.CA11009_1.CA11009_2;
136
                          -- Grandchild Package OS.File_Manager.Internals
137
 
138
     --=================================================================--
139
 
140
                          -- Grandchild Package body OS.File_Manager.Internals
141
package body CA11009_0.CA11009_1.CA11009_2 is
142
 
143
   function Next_Available_File return File_Descriptor_Type is
144
   begin
145
      File_Counter := File_Counter + 1;              -- Grandparent object.
146
      return (File_Descriptor_Type(File_Counter));
147
   end Next_Available_File;
148
   -------------------------------------------------------------------------
149
   function Create (Mode : File_Mode_Type)           -- Grandparent literal.
150
     return File_Descriptor_Type is
151
      Number : File_Descriptor_Type;                 -- Grandparent type.
152
   begin
153
      Number := Next_Available_File;
154
      File_Table(Number).Descriptor     := Number;   -- Grandparent object.
155
      File_Table(Number).Name           := Initial_Filename;
156
      File_Table(Number).Mode           := Mode;     -- Parameter.
157
      File_Table(Number).Acct_Access    := Initial_Permission;
158
      File_Table(Number).Current_Status := Initial_Status;
159
      return (Number);
160
   end Create;
161
 
162
end CA11009_0.CA11009_1.CA11009_2;
163
                          -- Grandchild Package body OS.File_Manager.Internals
164
 
165
     --=================================================================--
166
 
167
                                     -- "With" of a child package
168
                                     -- by the parent body.
169
with CA11009_0.CA11009_1.CA11009_2;  -- Grandchild OS.File_Manager.Internals
170
 
171
package body CA11009_0.CA11009_1 is  -- Child Package body OS.File_Manager
172
 
173
   package Internal renames CA11009_0.CA11009_1.CA11009_2;
174
 
175
   -- These subprograms utilize calls to subprograms contained in a private
176
   -- sibling to perform the actual processing.
177
 
178
   procedure Create_File (Mode      : in     File_Mode_Type;
179
                          File_Key  :    out File_Descriptor_Type) is
180
   begin
181
      File_Key := Internal.Create (Mode);
182
   end Create_File;
183
 
184
end CA11009_0.CA11009_1;        -- Child Package body OS.File_Manager
185
 
186
     --=================================================================--
187
 
188
with CA11009_0.CA11009_1;       -- with Child Package OS.File_Manager
189
with Report;
190
 
191
procedure CA11009 is
192
 
193
   package OS           renames CA11009_0;
194
   use OS;
195
   package File_Manager renames CA11009_0.CA11009_1;
196
 
197
   Data_Base_File_Key : File_Descriptor_Type := Default_Descriptor;
198
   New_Mode           : File_Mode_Type := Read_Write;
199
 
200
begin
201
 
202
   -- This test indicates one approach to file management.
203
   -- It is not intended to demonstrate full functionality, but rather
204
   -- that the use of a private child package could provide a solution
205
   -- to this type of situation.
206
 
207
   Report.Test ("CA11009", "Check that a private child package can use "   &
208
                           "entities declared in the visible part of the " &
209
                           "parent unit of its parent unit");
210
 
211
   -- Check initial conditions of the first entry in the file table.
212
   -- These are all default values provided in the declaration of the
213
   -- type File_Type.
214
 
215
   if (not (Data_Base_File_Key      = Default_Descriptor)) and then
216
      (((not (File_Table(1).Name    = Default_Filename))   or
217
      (File_Table(1).Descriptor     /= Default_Descriptor))  or else
218
      ((File_Table(1).Acct_Access   /= Default_Permission)  or
219
      (not (File_Table(1).Mode      = Default_Mode))       or
220
      (File_Table(1).Current_Status /= Default_Status)))
221
   then
222
      Report.Failed ("Initial condition failure");
223
   end if;
224
 
225
   -- Create/initialize file using the capability provided by the visible
226
   -- interface to the operating system, OS.File_Manager.  The actual
227
   -- processing routine is contained in the private grandchild package
228
   -- Internals, which utilize the components from the grandparent package.
229
 
230
   File_Manager.Create_File (New_Mode, Data_Base_File_Key);
231
 
232
   -- Verify that the initial conditions of the file table component have
233
   -- been properly modified by the initialization function.
234
 
235
   if not ((File_Table(1).Descriptor          = Data_Base_File_Key)   and then
236
           (File_Table(1).Name                = An_Ada_File_Name)  and then
237
           (File_Table(1).Acct_Access         = User)              and then
238
           not ((File_Table(1).Mode           = Default_Mode)      or else
239
                (File_Table(1).Current_Status = Default_Status)))
240
   then
241
      Report.Failed ("File creation failure");
242
   end if;
243
 
244
   Report.Result;
245
 
246
end CA11009;

powered by: WebSVN 2.1.0

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