URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca13002.a] - Rev 294
Compare with Previous | Blame | View Log
-- 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;