1-- CA11022.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 body of a child unit can instantiate its generic sibling.
28--
29-- TEST DESCRIPTION:
30--      Declare a package that provides some types for the graphic
31--      application.  Add a generic child package with a subprogram parameter
32--      to provide algorithms that can be used by different terminal types
33--      but that have to be customized to the specific terminal. Add child
34--      packages to take advantage of the parent types and to provide a
35--      customized operation for each of the different terminals.  The
36--      customized operation will be passed as a generic subprogram parameter
37--      to the child package's sibling.
38--
39--      The main program "with"s the child packages.  Check that the
40--      operations in child units perform as expected.
41--
42--
43-- CHANGE HISTORY:
44--      06 Dec 94   SAIC    ACVC 2.0
45--
46--!
47
48package CA11022_0 is    -- Graphic Manager
49
50   type Row is range 1 .. 66;
51   type Column is range 1 .. 80;
52   type Radius is range 1 .. 3;
53   type Length is range 5 .. 10;
54
55   -- Testing artifice.
56   TC_Screen : array (Row, Column) of boolean := (others => (others => false));
57   TC_Draw_Circle : boolean := false;
58   TC_Draw_Square : boolean := false;
59
60   -- ... and other complicated ones.
61
62end CA11022_0;
63
64-- No bodies required for CA11022_0.
65
66     --==================================================================--
67
68-- Child package to provide general graphic functionalities.
69
70generic
71
72   with procedure Put_Dot (X : in Column;
73                           Y : in Row);
74
75package CA11022_0.CA11022_1 is
76
77   procedure Draw_Square (At_Col : in Column;
78                          At_Row : in Row;
79                          Len    : in Length);
80
81   procedure Draw_Circle (At_Col : in Column;
82                          At_Row : in Row;
83                          Rad    : in Radius);
84
85   -- procedure Draw_Ellipse ...
86   -- and other drawings ...
87
88end CA11022_0.CA11022_1;
89
90     --==================================================================--
91
92package body CA11022_0.CA11022_1 is
93
94   procedure Draw_Square (At_Col : in Column;
95                          At_Row : in Row;
96                          Len    : in Length) is
97   begin
98      -- use square drawing algorithm
99      -- call
100      Put_Dot (At_Col + Column (Len), At_Row + Row(Len));
101      -- as needed in the algorithm.
102      TC_Draw_Square := true;
103   end Draw_Square;
104
105   -------------------------------------------------------
106   procedure Draw_Circle (At_Col : in Column;
107                          At_Row : in Row;
108                          Rad    : in Radius) is
109   begin
110      -- use circle drawing algorithm
111      -- call
112      for I in 1 .. Rad loop
113         Put_Dot (At_Col + Column(I), At_Row + Row(I));
114      end loop;
115      -- as needed in the algorithm.
116      TC_Draw_Circle := true;
117   end Draw_Circle;
118
119end CA11022_0.CA11022_1;
120
121     --==================================================================--
122
123with CA11022_0.CA11022_1;                -- Generic sibling.
124
125-- Child package to provide customized graphic functions for the
126-- VT100.
127package CA11022_0.CA11022_2 is           -- VT100 Graphic.
128
129   X : Column := 8;
130   Y : Row    := 3;
131   R : Radius := 2;
132   L : Length := 6;
133
134   procedure VT100_Graphic;
135
136end CA11022_0.CA11022_2;
137
138     --==================================================================--
139
140package body CA11022_0.CA11022_2 is
141
142   procedure VT100_Graphic is
143      procedure VT100_Putdot (X : in Column;
144                              Y : in Row) is
145      begin
146         -- Light a pixel at location (X, Y);
147         TC_Screen (Y, X) := true;
148      end VT100_Putdot;
149
150                  ------------------------------------
151
152      -- Declare instance of the generic sibling package to draw a circle,
153      -- a square, or an ellipse customized for the VT100.
154      package VT100_Graphic is new CA11022_0.CA11022_1 (VT100_Putdot);
155
156   begin
157      VT100_Graphic.Draw_Circle (X, Y, R);
158      VT100_Graphic.Draw_Square (X, Y, L);
159   end VT100_Graphic;
160
161end CA11022_0.CA11022_2;
162
163     --==================================================================--
164
165with CA11022_0.CA11022_1;                -- Generic sibling.
166
167-- Child package to provide customized graphic functions for the
168-- IBM3270.
169package CA11022_0.CA11022_3 is           -- IBM3270 Graphic.
170
171   X : Column := 39;
172   Y : Row    := 11;
173   R : Radius := 3;
174   L : Length := 7;
175
176   procedure IBM3270_Graphic;
177
178end CA11022_0.CA11022_3;
179
180     --==================================================================--
181
182package body CA11022_0.CA11022_3 is
183
184   procedure IBM3270_Graphic is
185      procedure IBM3270_Putdot (X : in Column;
186                             Y : in Row) is
187      begin
188         -- Light a pixel at location (X + 2, Y);
189         TC_Screen (Y, X + Column(2)) := true;
190      end IBM3270_Putdot;
191
192                  ------------------------------------
193
194      -- Declare instance of the generic sibling package to draw a circle,
195      -- a square, or an ellipse customized for the IBM3270.
196      package IBM3270_Graphic is new CA11022_0.CA11022_1 (IBM3270_Putdot);
197
198   begin
199      IBM3270_Graphic.Draw_Circle (X, Y, R);
200      IBM3270_Graphic.Draw_Square (X, Y, L);
201   end IBM3270_Graphic;
202
203end CA11022_0.CA11022_3;
204
205     --==================================================================--
206
207with CA11022_0.CA11022_2;              -- VT100 Graphic, implicitly with
208                                       -- CA11022_0, Graphic Manager.
209with CA11022_0.CA11022_3;              -- IBM3270 Graphic.
210with Report;
211
212procedure CA11022 is
213
214begin
215
216   Report.Test ("CA11022", "Check that body of a child unit can depend on " &
217                "its generic sibling");
218
219   -- Customized graphic functions for the VT100 terminal.
220   CA11022_0.CA11022_2.VT100_Graphic;
221
222   if not CA11022_0.TC_Screen (4,9) and not CA11022_0.TC_Screen (5,10)
223     and not CA11022_0.TC_Screen (9,14) and not CA11022_0.TC_Draw_Circle
224       and not CA11022_0.TC_Draw_Square then
225          Report.Failed ("Wrong results for the VT100");
226   end if;
227
228   CA11022_0.TC_Draw_Circle := false;
229   CA11022_0.TC_Draw_Square := false;
230
231   -- Customized graphic functions for the IBM3270 terminal.
232   CA11022_0.CA11022_3.IBM3270_Graphic;
233
234   if not CA11022_0.TC_Screen (12,42) and not CA11022_0.TC_Screen (13,43)
235     and not CA11022_0.TC_Screen (14,44) and not CA11022_0.TC_Screen (46,18)
236       and not CA11022_0.TC_Draw_Circle and not CA11022_0.TC_Draw_Square then
237          Report.Failed ("Wrong results for the IBM3270");
238   end if;
239
240   Report.Result;
241
242end CA11022;
243