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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca13a01.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CA13A01.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 subunits declared in non-generic child units of a public
28
--      parent have the same visibility into its parent, its siblings
29
--      (public and private), and packages on which its parent depends
30
--      as is available at the point of their declaration.
31
--
32
-- TEST DESCRIPTION:
33
--      Declare an check system procedure as a subunit in a private child
34
--      package of the basic operation package (FA13A00.A).  This procedure
35
--      has visibility into its parent ancestor and its private sibling.
36
--
37
--      Declare an emergency procedure as a subunit in a public child package
38
--      of the basic operation package (FA13A00.A).  This procedure has
39
--      visibility into its parent ancestor and its private sibling.
40
--
41
--      Declare an express procedure as a subunit in a public child subprogram
42
--      of the basic operation package (FA13A00.A).  This procedure has
43
--      visibility into its parent ancestor and its public sibling.
44
--
45
--      In the main program, "with"s the child package and subprogram.  Check
46
--      that subunits perform as expected.
47
--
48
-- TEST FILES:
49
--      The following files comprise this test:
50
--
51
--         FA13A00.A
52
--         CA13A01.A
53
--
54
--
55
-- CHANGE HISTORY:
56
--      06 Dec 94   SAIC    ACVC 2.0
57
--
58
--!
59
 
60
-- Private child package of an elevator application.  This package
61
-- provides maintenance operations.
62
 
63
private package FA13A00_1.CA13A01_4 is    -- Maintenance operation
64
 
65
   One_Floor : Floor_No := 1;             -- Type declared in parent.
66
 
67
   procedure Check_System;
68
 
69
   -- other type definitions and procedure declarations in real application.
70
 
71
end FA13A00_1.CA13A01_4;
72
 
73
     --==================================================================--
74
 
75
-- Context clauses required for visibility needed by separate subunit.
76
 
77
with FA13A00_0;                           -- Building Manager
78
 
79
with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
80
 
81
with FA13A00_1.FA13A00_3;                 -- Move Elevator
82
 
83
use  FA13A00_0;
84
 
85
package body FA13A00_1.CA13A01_4 is
86
 
87
   procedure Check_System is separate;
88
 
89
end FA13A00_1.CA13A01_4;
90
 
91
     --==================================================================--
92
 
93
separate (FA13A00_1.CA13A01_4)
94
 
95
-- Subunit Check_System declared in Maintenance Operation.
96
 
97
procedure Check_System is
98
begin
99
   -- See if regular power is on.
100
 
101
   if Power /= V120 then                  -- Reference package with'ed by
102
      TC_Operation := false;              -- the subunit parent's body.
103
   end if;
104
 
105
   -- Test elevator function.
106
 
107
   FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of
108
     (Penthouse, Call_Waiting);           -- the subunit parent's body.
109
 
110
   if not Call_Waiting (Penthouse) then   -- Reference private part of the
111
      TC_Operation := false;              -- parent of the subunit package's
112
                                          -- body.
113
   end if;
114
 
115
   FA13A00_1.FA13A00_2.Down (One_Floor);  -- Reference private sibling of
116
                                          -- the subunit parent's body.
117
 
118
   if Current_Floor /= Floor'pred (Penthouse) then
119
      TC_Operation := false;              -- Reference type declared in the
120
   end if;                                -- parent of the subunit parent's
121
                                          -- body.
122
 
123
end Check_System;
124
 
125
     --==================================================================--
126
 
127
-- Public child package of an elevator application.  This package provides
128
-- an emergency operation.
129
 
130
package FA13A00_1.CA13A01_5 is            -- Emergency Operation
131
 
132
   -- Other type definitions in real application.
133
 
134
   procedure Emergency;
135
 
136
private
137
   type Bell_Type is (Inactive, Active);
138
 
139
end FA13A00_1.CA13A01_5;
140
 
141
     --==================================================================--
142
 
143
-- Context clauses required for visibility needed by separate subunit.
144
 
145
with FA13A00_0;                           -- Building Manager
146
 
147
with FA13A00_1.FA13A00_3;                 -- Move Elevator
148
 
149
with FA13A00_1.CA13A01_4;                 -- Maintenance Operation (private)
150
 
151
use  FA13A00_0;
152
 
153
package body FA13A00_1.CA13A01_5 is
154
 
155
   procedure Emergency is separate;
156
 
157
end FA13A00_1.CA13A01_5;
158
 
159
     --==================================================================--
160
 
161
separate (FA13A00_1.CA13A01_5)
162
 
163
-- Subunit Emergency declared in Maintenance Operation.
164
 
165
procedure Emergency is
166
   Bell : Bell_Type;                      -- Reference type declared in the
167
                                          -- subunit parent's body.
168
 
169
begin
170
   -- Calls maintenance operation.
171
 
172
   FA13A00_1.CA13A01_4.Check_System;      -- Reference private sibling of the
173
                                          -- subunit parent 's body.
174
 
175
   -- Clear all calls to the elevator.
176
 
177
   Clear_Calls (Call_Waiting);            -- Reference subprogram declared
178
                                          -- in the parent of the subunit
179
                                          -- parent's body.
180
   for I in Floor loop
181
      if Call_Waiting (I) then            -- Reference private part of the
182
        TC_Operation := false;            -- parent of the subunit parent's
183
      end if;                             -- body.
184
   end loop;
185
 
186
   -- Move elevator to the basement.
187
 
188
   FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
189
     (Basement, Call_Waiting);            -- subunit parent's body.
190
 
191
   if Current_Floor /= Basement then      -- Reference type declared in the
192
      TC_Operation := false;              -- parent of the subunit parent's
193
   end if;                                -- body.
194
 
195
   -- Shut off power.
196
 
197
   Power := Off;                          -- Reference package with'ed by
198
                                          -- the subunit parent's body.
199
 
200
   -- Activate bell.
201
 
202
   Bell := Active;                        -- Reference type declared in the
203
                                          -- subunit parent's body.
204
 
205
end Emergency;
206
 
207
     --==================================================================--
208
 
209
-- Public child subprogram of an elevator application.  This subprogram
210
-- provides an express operation.
211
 
212
procedure FA13A00_1.CA13A01_6;
213
 
214
     --==================================================================--
215
 
216
-- Context clauses required for visibility needed by separate subunit.
217
 
218
with FA13A00_0;                           -- Building Manager
219
 
220
with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
221
 
222
with FA13A00_1.FA13A00_3;                 -- Move Elevator
223
 
224
use  FA13A00_0;
225
 
226
procedure FA13A00_1.CA13A01_6 is          -- Express Operation
227
 
228
   -- Other type definitions in real application.
229
 
230
   procedure GoTo_Penthouse is separate;
231
 
232
begin
233
   GoTo_Penthouse;
234
 
235
end FA13A00_1.CA13A01_6;
236
 
237
     --==================================================================--
238
 
239
separate (FA13A00_1.CA13A01_6)
240
 
241
-- Subunit GoTo_Penthouse declared in Express Operation.
242
 
243
procedure GoTo_Penthouse is
244
begin
245
   -- Go faster.
246
 
247
   Power := V240;                         -- Reference package with'ed by
248
                                          -- the subunit parent's body.
249
 
250
   -- Call elevator.
251
 
252
   Call (Penthouse, Call_Waiting);        -- Reference subprogram declared in
253
                                          -- the parent of the subunit
254
                                          -- parent's body.
255
 
256
   if not Call_Waiting (Penthouse) then   -- Reference private part of the
257
      TC_Operation := false;              -- parent of the subunit parent's
258
   end if;                                -- body.
259
 
260
   -- Move elevator to Penthouse.
261
 
262
   FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
263
     (Penthouse, Call_Waiting);           -- subunit parent's body.
264
 
265
   if Current_Floor /= Penthouse then     -- Reference type declared in the
266
      TC_Operation := false;              -- parent of the subunit parent's
267
   end if;                                -- body.
268
 
269
   -- Return slowly
270
 
271
   while Current_Floor /= Floor1 loop     -- Reference type, subprogram
272
      FA13A00_1.FA13A00_2.Down (1);       -- declared in the parent of the
273
                                          -- subunit parent's body.
274
   end loop;
275
 
276
   if Current_Floor /= Floor1 then        -- Reference type declared in
277
      TC_Operation := false;              -- the parent of the subunit
278
   end if;                                -- parent's body.
279
 
280
   -- Back to normal.
281
 
282
   Power := V120;                         -- Reference package with'ed by
283
                                          -- the subunit parent's body.
284
 
285
end GoTo_Penthouse;
286
 
287
     --==================================================================--
288
 
289
with FA13A00_1.CA13A01_5;                 -- Emergency Operation
290
                                          -- implicitly with Basic Elevator
291
                                          -- Operations
292
 
293
with FA13A00_1.CA13A01_6;                 -- Express Operation
294
 
295
with Report;
296
 
297
procedure CA13A01 is
298
 
299
begin
300
 
301
   Report.Test ("CA13A01", "Check that subunits declared in non-generic " &
302
                "child units of a public parent have the same visibility " &
303
                "into its parent, its parent's siblings, and packages on " &
304
                "which its parent depends");
305
 
306
   -- Go to Penthouse.
307
 
308
   FA13A00_1.CA13A01_6;
309
 
310
   -- Call emergency operation.
311
 
312
   FA13A00_1.CA13A01_5.Emergency;
313
 
314
   if not FA13A00_1.TC_Operation then
315
      Report.Failed ("Incorrect elevator operation");
316
   end if;
317
 
318
   Report.Result;
319
 
320
end CA13A01;

powered by: WebSVN 2.1.0

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