ca13002.a

来自「linux下编程用 编译软件」· A 代码 · 共 260 行

-- CA13002.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 two library child units and/or subunits may have the same 
--      simple names if they have distinct expanded names.
--
-- TEST DESCRIPTION:
--      Declare a package that provides some primitive functionality (minimal
--      terminal driver operations in this case).  Add child packages to 
--      expand the functionality for different but related contexts (different
--      terminal kinds).  Add child packages, or subunits, to the children to
--      provide the same high level operation for each of the different 
--      contexts (terminals).  Since the operations are the same, at the leaf
--      level they are likely to have the same names.
--
--      The main program "with"s the child packages.  Check that the
--      child units and subunits perform as expected.  
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!
   
-- Public parent.
package CA13002_0 is                     -- Terminal_Driver.

   type TC_Name is (First_Child, Second_Child, Third_Child, Fourth_Child);
   type TC_Call_From is (First_Grandchild, Second_Grandchild, First_Subunit, 
                           Second_Subunit);
   type TC_Calls_Arr is array (TC_Name, TC_Call_From) of boolean;
   TC_Calls : TC_Calls_Arr := (others => (others => false));

   -- In real application, Send_Control_Sequence sends keystrokes from
   -- the terminal, i.e., space, escape, etc.
   procedure Send_Control_Sequence (Row : in TC_Name;
                                    Col : in TC_Call_From);

end CA13002_0;

     --==================================================================--

-- First child.
package CA13002_0.CA13002_1 is           -- Terminal_Driver.VT100

   -- Move cursor up, down, left, or right.
   procedure Move_Cursor (Col : in TC_Call_From);

end CA13002_0.CA13002_1;

     --==================================================================--

-- First grandchild.
procedure CA13002_0.CA13002_1.CA13002_5; -- Terminal_Driver.VT100.Cursor_Up

     --==================================================================--

-- Second child.
package CA13002_0.CA13002_2 is           -- Terminal_Driver.IBM3270

   procedure Move_Cursor (Col : in TC_Call_From);

end CA13002_0.CA13002_2;

     --==================================================================--

-- Second grandchild.
procedure CA13002_0.CA13002_2.CA13002_5; -- Terminal_Driver.IBM3270.Cursor_Up

     --==================================================================--

-- Third child.
package CA13002_0.CA13002_3 is           -- Terminal_Driver.DOS_ANSI

   procedure Move_Cursor (Col : in TC_Call_From);

   procedure CA13002_5;                  -- Terminal_Driver.DOS_ANSI.Cursor_Up
                                         -- implementation will be as a 
                                         -- separate subunit.
end CA13002_0.CA13002_3;

     --==================================================================--

-- Fourth child.
package CA13002_0.CA13002_4 is           -- Terminal_Driver.WYSE

   procedure Move_Cursor (Col : in TC_Call_From);

   procedure CA13002_5;                  -- Terminal_Driver.WYSE.Cursor_Up
                                         -- implementation will be as a 
                                         -- separate subunit.

end CA13002_0.CA13002_4;

     --==================================================================--

-- Terminal_Driver.
package body CA13002_0 is                  

   procedure Send_Control_Sequence (Row : in TC_Name;
                                    Col : in TC_Call_From) is
   begin
      -- Reads a key and takes action.
      TC_Calls (Row, Col) := true;
   end Send_Control_Sequence;

end CA13002_0;

     --==================================================================--

-- Terminal_Driver.VT100.
package body CA13002_0.CA13002_1 is                     

   procedure Move_Cursor (Col : in TC_Call_From) is
   begin
      Send_Control_Sequence (First_Child, Col);
   end Move_Cursor;

end CA13002_0.CA13002_1;

     --==================================================================--

-- Terminal_Driver.VT100.Cursor_Up.
procedure CA13002_0.CA13002_1.CA13002_5 is 
begin
   Move_Cursor (First_Grandchild);        -- from Terminal_Driver.VT100.
end CA13002_0.CA13002_1.CA13002_5;

     --==================================================================--

-- Terminal_Driver.IBM3270.
package body CA13002_0.CA13002_2 is                     

   procedure Move_Cursor (Col : in TC_Call_From) is
   begin
      Send_Control_Sequence (Second_Child, Col);
   end Move_Cursor;

end CA13002_0.CA13002_2;

     --==================================================================--

-- Terminal_Driver.IBM3270.Cursor_Up.
procedure CA13002_0.CA13002_2.CA13002_5 is 
begin
   Move_Cursor (Second_Grandchild);       -- from Terminal_Driver.IBM3270.
end CA13002_0.CA13002_2.CA13002_5;

     --==================================================================--

-- Terminal_Driver.DOS_ANSI.
package body CA13002_0.CA13002_3 is                     

   procedure Move_Cursor (Col : in TC_Call_From) is
   begin
      Send_Control_Sequence (Third_Child, Col);
   end Move_Cursor;

   procedure CA13002_5 is separate;

end CA13002_0.CA13002_3;

     --==================================================================--

-- Terminal_Driver.DOS_ANSI.Cursor_Up.
separate (CA13002_0.CA13002_3)
procedure CA13002_5 is 
begin
   Move_Cursor (First_Subunit);           -- from Terminal_Driver.DOS_ANSI.
end CA13002_5;

     --==================================================================--

-- Terminal_Driver.WYSE.
package body CA13002_0.CA13002_4 is                     

   procedure Move_Cursor (Col : in TC_Call_From) is
   begin
      Send_Control_Sequence (Fourth_Child, Col);
   end Move_Cursor;

   procedure CA13002_5 is separate;

end CA13002_0.CA13002_4;

     --==================================================================--

-- Terminal_Driver.WYSE.Cursor_Up.
separate (CA13002_0.CA13002_4)
procedure CA13002_5 is 
begin
   Move_Cursor (Second_Subunit);          -- from Terminal_Driver.WYSE.
end CA13002_5;

     --==================================================================--

with CA13002_0.CA13002_1.CA13002_5;     -- Terminal_Driver.VT100.Cursor_Up,
                                        -- implicitly with parent, CA13002_0.
with CA13002_0.CA13002_2.CA13002_5;     -- Terminal_Driver.IBM3270.Cursor_Up.
with CA13002_0.CA13002_3;               -- Terminal_Driver.DOS_ANSI.
with CA13002_0.CA13002_4;               -- Terminal_Driver.WYSE.
with Report;
use  CA13002_0;                         -- All primitive subprograms directly
                                        -- visible.

procedure CA13002 is
   Expected_Calls : constant CA13002_0.TC_Calls_Arr 
                  := ((true,  false, false, false),
                      (false, true , false, false),
                      (false, false, true , false),
                      (false, false, false, true ));
begin
   Report.Test ("CA13002", "Check that two library units and/or subunits " &
                "may have the same simple names if they have distinct " &
                "expanded names");

   -- Note that the leaves all have the same name.
   -- Call the first grandchild.
   CA13002_0.CA13002_1.CA13002_5;       

   -- Call the second grandchild.
   CA13002_0.CA13002_2.CA13002_5;

   -- Call the first subunit.
   CA13002_0.CA13002_3.CA13002_5;

   -- Call the second subunit.
   CA13002_0.CA13002_4.CA13002_5;

   if TC_Calls /= Expected_Calls then
      Report.Failed ("Wrong result");
   end if;  

   Report.Result;

end CA13002;