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