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
|
-- CA13A02.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 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 outside elevator button operation as a subunit in a
-- generic child package of the basic operation package (FA13A00.A).
-- This procedure has visibility into its parent ancestor and its
-- private sibling.
--
-- In the main program, instantiate the child package. Check that
-- subunits perform as expected.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- FA13A00.A
-- CA13A02.A
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
-- Public generic child package of an elevator application. This package
-- provides outside elevator button operations.
generic -- Instantiate once for each floor.
Our_Floor : in Floor; -- Reference type declared in parent.
package FA13A00_1.CA13A02_4 is -- Outside Elevator Button Operations
type Light is (Up, Down, Express, Off);
type Direction is (Up, Down, Express);
function Call_Elevator (D : Direction) return Light;
-- other type definitions and procedure declarations in real application.
end FA13A00_1.CA13A02_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.CA13A02_4 is
function Call_Elevator (D : Direction) return Light is separate;
end FA13A00_1.CA13A02_4;
--==================================================================--
separate (FA13A00_1.CA13A02_4)
-- Subunit Call_Elevator declared in Outside Elevator Button Operations.
function Call_Elevator (D : Direction) return Light is
Elevator_Button : Light;
begin
-- See if power is on.
if Power = Off then -- Reference package with'ed by
Elevator_Button := Off; -- the subunit parent's body.
else
case D is
when Express =>
FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of
(Penthouse, Call_Waiting); -- the subunit parent's body.
Elevator_Button := Express;
when Up =>
if Current_Floor < Our_Floor then
FA13A00_1.FA13A00_2.Up -- Reference private sibling of
(Floor'pos (Our_Floor) -- the subunit parent's body.
- Floor'pos (Current_Floor));
else
FA13A00_1.FA13A00_2.Down -- Reference private sibling of
(Floor'pos (Current_Floor) -- the subunit parent's body.
- Floor'pos (Our_Floor));
end if;
-- Call elevator.
Call
(Current_Floor, Call_Waiting); -- Reference subprogram declared
-- in the parent of the subunit
-- parent's body.
Elevator_Button := Up;
when Down =>
if Current_Floor > Our_Floor then
FA13A00_1.FA13A00_2.Down -- Reference private sibling of
(Floor'pos (Current_Floor) -- the subunit parent's body.
- Floor'pos (Our_Floor));
else
FA13A00_1.FA13A00_2.Up -- Reference private sibling of
(Floor'pos (Our_Floor) -- the subunit parent's body.
- Floor'pos (Current_Floor));
end if;
Elevator_Button := Down;
-- Call elevator.
Call
(Current_Floor, Call_Waiting); -- Reference subprogram declared
-- in the parent of the subunit
-- parent's body.
end case;
if not Call_Waiting (Current_Floor) -- Reference private part of the
then -- parent of the subunit parent's
-- body.
TC_Operation := false;
end if;
end if;
return Elevator_Button;
end Call_Elevator;
--==================================================================--
with FA13A00_1.CA13A02_4; -- Outside Elevator Button Operations
-- implicitly with Basic Elevator
-- Operations
with Report;
procedure CA13A02 is
begin
Report.Test ("CA13A02", "Check that subunits declared in 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");
-- Going from floor one to penthouse.
Going_To_Penthouse:
declare
-- Declare instance of the child generic elevator package for penthouse.
package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4
(FA13A00_1.Penthouse);
use Call_Elevator_Pkg;
Call_Button_Light : Light;
begin
Call_Button_Light := Call_Elevator (Express);
if not FA13A00_1.TC_Operation or Call_Button_Light /= Express then
Report.Failed ("Incorrect elevator operation going to penthouse");
end if;
end Going_To_Penthouse;
-- Going from penthouse to basement.
Going_To_Basement:
declare
-- Declare instance of the child generic elevator package for basement.
package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4
(FA13A00_1.Basement);
use Call_Elevator_Pkg;
Call_Button_Light : Light;
begin
Call_Button_Light := Call_Elevator (Down);
if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
Report.Failed ("Incorrect elevator operation going to basement");
end if;
end Going_To_Basement;
-- Going from basement to floor three.
Going_To_Floor3:
declare
-- Declare instance of the child generic elevator package for floor
-- three.
package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4
(FA13A00_1.Floor3);
use Call_Elevator_Pkg;
Call_Button_Light : Light;
begin
Call_Button_Light := Call_Elevator (Up);
if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
Report.Failed ("Incorrect elevator operation going to floor 3");
end if;
end Going_To_Floor3;
-- Going from floor three to floor two.
Going_To_Floor2:
declare
-- Declare instance of the child generic elevator package for floor two.
package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4
(FA13A00_1.Floor2);
use Call_Elevator_Pkg;
Call_Button_Light : Light;
begin
Call_Button_Light := Call_Elevator (Up);
if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
Report.Failed ("Incorrect elevator operation going to floor 2");
end if;
end Going_To_Floor2;
-- Going to floor one.
Going_To_Floor1:
declare
-- Declare instance of the child generic elevator package for floor one.
package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4
(FA13A00_1.Floor1);
use Call_Elevator_Pkg;
Call_Button_Light : Light;
begin
-- Calling elevator from floor one.
FA13A00_1.Current_Floor := FA13A00_1.Floor1;
Call_Button_Light := Call_Elevator (Down);
if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
Report.Failed ("Incorrect elevator operation going to floor 1");
end if;
end Going_To_Floor1;
Report.Result;
end CA13A02;
|
