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
|
-- CA11022.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 body of a child unit can instantiate its generic sibling.
--
-- TEST DESCRIPTION:
-- Declare a package that provides some types for the graphic
-- application. Add a generic child package with a subprogram parameter
-- to provide algorithms that can be used by different terminal types
-- but that have to be customized to the specific terminal. Add child
-- packages to take advantage of the parent types and to provide a
-- customized operation for each of the different terminals. The
-- customized operation will be passed as a generic subprogram parameter
-- to the child package's sibling.
--
-- The main program "with"s the child packages. Check that the
-- operations in child units perform as expected.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
package CA11022_0 is -- Graphic Manager
type Row is range 1 .. 66;
type Column is range 1 .. 80;
type Radius is range 1 .. 3;
type Length is range 5 .. 10;
-- Testing artifice.
TC_Screen : array (Row, Column) of boolean := (others => (others => false));
TC_Draw_Circle : boolean := false;
TC_Draw_Square : boolean := false;
-- ... and other complicated ones.
end CA11022_0;
-- No bodies required for CA11022_0.
--==================================================================--
-- Child package to provide general graphic functionalities.
generic
with procedure Put_Dot (X : in Column;
Y : in Row);
package CA11022_0.CA11022_1 is
procedure Draw_Square (At_Col : in Column;
At_Row : in Row;
Len : in Length);
procedure Draw_Circle (At_Col : in Column;
At_Row : in Row;
Rad : in Radius);
-- procedure Draw_Ellipse ...
-- and other drawings ...
end CA11022_0.CA11022_1;
--==================================================================--
package body CA11022_0.CA11022_1 is
procedure Draw_Square (At_Col : in Column;
At_Row : in Row;
Len : in Length) is
begin
-- use square drawing algorithm
-- call
Put_Dot (At_Col + Column (Len), At_Row + Row(Len));
-- as needed in the algorithm.
TC_Draw_Square := true;
end Draw_Square;
-------------------------------------------------------
procedure Draw_Circle (At_Col : in Column;
At_Row : in Row;
Rad : in Radius) is
begin
-- use circle drawing algorithm
-- call
for I in 1 .. Rad loop
Put_Dot (At_Col + Column(I), At_Row + Row(I));
end loop;
-- as needed in the algorithm.
TC_Draw_Circle := true;
end Draw_Circle;
end CA11022_0.CA11022_1;
--==================================================================--
with CA11022_0.CA11022_1; -- Generic sibling.
-- Child package to provide customized graphic functions for the
-- VT100.
package CA11022_0.CA11022_2 is -- VT100 Graphic.
X : Column := 8;
Y : Row := 3;
R : Radius := 2;
L : Length := 6;
procedure VT100_Graphic;
end CA11022_0.CA11022_2;
--==================================================================--
package body CA11022_0.CA11022_2 is
procedure VT100_Graphic is
procedure VT100_Putdot (X : in Column;
Y : in Row) is
begin
-- Light a pixel at location (X, Y);
TC_Screen (Y, X) := true;
end VT100_Putdot;
------------------------------------
-- Declare instance of the generic sibling package to draw a circle,
-- a square, or an ellipse customized for the VT100.
package VT100_Graphic is new CA11022_0.CA11022_1 (VT100_Putdot);
begin
VT100_Graphic.Draw_Circle (X, Y, R);
VT100_Graphic.Draw_Square (X, Y, L);
end VT100_Graphic;
end CA11022_0.CA11022_2;
--==================================================================--
with CA11022_0.CA11022_1; -- Generic sibling.
-- Child package to provide customized graphic functions for the
-- IBM3270.
package CA11022_0.CA11022_3 is -- IBM3270 Graphic.
X : Column := 39;
Y : Row := 11;
R : Radius := 3;
L : Length := 7;
procedure IBM3270_Graphic;
end CA11022_0.CA11022_3;
--==================================================================--
package body CA11022_0.CA11022_3 is
procedure IBM3270_Graphic is
procedure IBM3270_Putdot (X : in Column;
Y : in Row) is
begin
-- Light a pixel at location (X + 2, Y);
TC_Screen (Y, X + Column(2)) := true;
end IBM3270_Putdot;
------------------------------------
-- Declare instance of the generic sibling package to draw a circle,
-- a square, or an ellipse customized for the IBM3270.
package IBM3270_Graphic is new CA11022_0.CA11022_1 (IBM3270_Putdot);
begin
IBM3270_Graphic.Draw_Circle (X, Y, R);
IBM3270_Graphic.Draw_Square (X, Y, L);
end IBM3270_Graphic;
end CA11022_0.CA11022_3;
--==================================================================--
with CA11022_0.CA11022_2; -- VT100 Graphic, implicitly with
-- CA11022_0, Graphic Manager.
with CA11022_0.CA11022_3; -- IBM3270 Graphic.
with Report;
procedure CA11022 is
begin
Report.Test ("CA11022", "Check that body of a child unit can depend on " &
"its generic sibling");
-- Customized graphic functions for the VT100 terminal.
CA11022_0.CA11022_2.VT100_Graphic;
if not CA11022_0.TC_Screen (4,9) and not CA11022_0.TC_Screen (5,10)
and not CA11022_0.TC_Screen (9,14) and not CA11022_0.TC_Draw_Circle
and not CA11022_0.TC_Draw_Square then
Report.Failed ("Wrong results for the VT100");
end if;
CA11022_0.TC_Draw_Circle := false;
CA11022_0.TC_Draw_Square := false;
-- Customized graphic functions for the IBM3270 terminal.
CA11022_0.CA11022_3.IBM3270_Graphic;
if not CA11022_0.TC_Screen (12,42) and not CA11022_0.TC_Screen (13,43)
and not CA11022_0.TC_Screen (14,44) and not CA11022_0.TC_Screen (46,18)
and not CA11022_0.TC_Draw_Circle and not CA11022_0.TC_Draw_Square then
Report.Failed ("Wrong results for the IBM3270");
end if;
Report.Result;
end CA11022;
|
