| -- 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; |
