diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11022.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11022.a | 242 |
1 files changed, 0 insertions, 242 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11022.a b/gcc/testsuite/ada/acats/tests/ca/ca11022.a deleted file mode 100644 index 60cbc08ce0a..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11022.a +++ /dev/null @@ -1,242 +0,0 @@ --- 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; |