1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
|
-- CA13A01.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that subunits declared in non-generic child units of a public
-- parent have the same visibility into its parent, its siblings
-- (public and private), and packages on which its parent depends
-- as is available at the point of their declaration.
--
-- TEST DESCRIPTION:
-- Declare an check system procedure as a subunit in a private child
-- package of the basic operation package (FA13A00.A). This procedure
-- has visibility into its parent ancestor and its private sibling.
--
-- Declare an emergency procedure as a subunit in a public child package
-- of the basic operation package (FA13A00.A). This procedure has
-- visibility into its parent ancestor and its private sibling.
--
-- Declare an express procedure as a subunit in a public child subprogram
-- of the basic operation package (FA13A00.A). This procedure has
-- visibility into its parent ancestor and its public sibling.
--
-- In the main program, "with"s the child package and subprogram. Check
-- that subunits perform as expected.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- FA13A00.A
-- CA13A01.A
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
-- Private child package of an elevator application. This package
-- provides maintenance operations.
private package FA13A00_1.CA13A01_4 is -- Maintenance operation
One_Floor : Floor_No := 1; -- Type declared in parent.
procedure Check_System;
-- other type definitions and procedure declarations in real application.
end FA13A00_1.CA13A01_4;
--==================================================================--
-- Context clauses required for visibility needed by separate subunit.
with FA13A00_0; -- Building Manager
with FA13A00_1.FA13A00_2; -- Floor Calculation (private)
with FA13A00_1.FA13A00_3; -- Move Elevator
use FA13A00_0;
package body FA13A00_1.CA13A01_4 is
procedure Check_System is separate;
end FA13A00_1.CA13A01_4;
--==================================================================--
separate (FA13A00_1.CA13A01_4)
-- Subunit Check_System declared in Maintenance Operation.
procedure Check_System is
begin
-- See if regular power is on.
if Power /= V120 then -- Reference package with'ed by
TC_Operation := false; -- the subunit parent's body.
end if;
-- Test elevator function.
FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of
(Penthouse, Call_Waiting); -- the subunit parent's body.
if not Call_Waiting (Penthouse) then -- Reference private part of the
TC_Operation := false; -- parent of the subunit package's
-- body.
end if;
FA13A00_1.FA13A00_2.Down (One_Floor); -- Reference private sibling of
-- the subunit parent's body.
if Current_Floor /= Floor'pred (Penthouse) then
TC_Operation := false; -- Reference type declared in the
end if; -- parent of the subunit parent's
-- body.
end Check_System;
--==================================================================--
-- Public child package of an elevator application. This package provides
-- an emergency operation.
package FA13A00_1.CA13A01_5 is -- Emergency Operation
-- Other type definitions in real application.
procedure Emergency;
private
type Bell_Type is (Inactive, Active);
end FA13A00_1.CA13A01_5;
--==================================================================--
-- Context clauses required for visibility needed by separate subunit.
with FA13A00_0; -- Building Manager
with FA13A00_1.FA13A00_3; -- Move Elevator
with FA13A00_1.CA13A01_4; -- Maintenance Operation (private)
use FA13A00_0;
package body FA13A00_1.CA13A01_5 is
procedure Emergency is separate;
end FA13A00_1.CA13A01_5;
--==================================================================--
separate (FA13A00_1.CA13A01_5)
-- Subunit Emergency declared in Maintenance Operation.
procedure Emergency is
Bell : Bell_Type; -- Reference type declared in the
-- subunit parent's body.
begin
-- Calls maintenance operation.
FA13A00_1.CA13A01_4.Check_System; -- Reference private sibling of the
-- subunit parent 's body.
-- Clear all calls to the elevator.
Clear_Calls (Call_Waiting); -- Reference subprogram declared
-- in the parent of the subunit
-- parent's body.
for I in Floor loop
if Call_Waiting (I) then -- Reference private part of the
TC_Operation := false; -- parent of the subunit parent's
end if; -- body.
end loop;
-- Move elevator to the basement.
FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of the
(Basement, Call_Waiting); -- subunit parent's body.
if Current_Floor /= Basement then -- Reference type declared in the
TC_Operation := false; -- parent of the subunit parent's
end if; -- body.
-- Shut off power.
Power := Off; -- Reference package with'ed by
-- the subunit parent's body.
-- Activate bell.
Bell := Active; -- Reference type declared in the
-- subunit parent's body.
end Emergency;
--==================================================================--
-- Public child subprogram of an elevator application. This subprogram
-- provides an express operation.
procedure FA13A00_1.CA13A01_6;
--==================================================================--
-- Context clauses required for visibility needed by separate subunit.
with FA13A00_0; -- Building Manager
with FA13A00_1.FA13A00_2; -- Floor Calculation (private)
with FA13A00_1.FA13A00_3; -- Move Elevator
use FA13A00_0;
procedure FA13A00_1.CA13A01_6 is -- Express Operation
-- Other type definitions in real application.
procedure GoTo_Penthouse is separate;
begin
GoTo_Penthouse;
end FA13A00_1.CA13A01_6;
--==================================================================--
separate (FA13A00_1.CA13A01_6)
-- Subunit GoTo_Penthouse declared in Express Operation.
procedure GoTo_Penthouse is
begin
-- Go faster.
Power := V240; -- Reference package with'ed by
-- the subunit parent's body.
-- Call elevator.
Call (Penthouse, Call_Waiting); -- Reference subprogram declared in
-- the parent of the subunit
-- parent's body.
if not Call_Waiting (Penthouse) then -- Reference private part of the
TC_Operation := false; -- parent of the subunit parent's
end if; -- body.
-- Move elevator to Penthouse.
FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of the
(Penthouse, Call_Waiting); -- subunit parent's body.
if Current_Floor /= Penthouse then -- Reference type declared in the
TC_Operation := false; -- parent of the subunit parent's
end if; -- body.
-- Return slowly
while Current_Floor /= Floor1 loop -- Reference type, subprogram
FA13A00_1.FA13A00_2.Down (1); -- declared in the parent of the
-- subunit parent's body.
end loop;
if Current_Floor /= Floor1 then -- Reference type declared in
TC_Operation := false; -- the parent of the subunit
end if; -- parent's body.
-- Back to normal.
Power := V120; -- Reference package with'ed by
-- the subunit parent's body.
end GoTo_Penthouse;
--==================================================================--
with FA13A00_1.CA13A01_5; -- Emergency Operation
-- implicitly with Basic Elevator
-- Operations
with FA13A00_1.CA13A01_6; -- Express Operation
with Report;
procedure CA13A01 is
begin
Report.Test ("CA13A01", "Check that subunits declared in non-generic " &
"child units of a public parent have the same visibility " &
"into its parent, its parent's siblings, and packages on " &
"which its parent depends");
-- Go to Penthouse.
FA13A00_1.CA13A01_6;
-- Call emergency operation.
FA13A00_1.CA13A01_5.Emergency;
if not FA13A00_1.TC_Operation then
Report.Failed ("Incorrect elevator operation");
end if;
Report.Result;
end CA13A01;
|
