ca11022.a

用于进行gcc测试

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