-- CA13A01.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 subunits declared in non-generic child units of a public -- parent have the same visibility into its parent, its siblings -- (public and private), and packages on which its parent depends -- as is available at the point of their declaration. -- -- TEST DESCRIPTION: -- Declare an check system procedure as a subunit in a private child -- package of the basic operation package (FA13A00.A). This procedure -- has visibility into its parent ancestor and its private sibling. -- -- Declare an emergency procedure as a subunit in a public child package -- of the basic operation package (FA13A00.A). This procedure has -- visibility into its parent ancestor and its private sibling. -- -- Declare an express procedure as a subunit in a public child subprogram -- of the basic operation package (FA13A00.A). This procedure has -- visibility into its parent ancestor and its public sibling. -- -- In the main program, "with"s the child package and subprogram. Check -- that subunits perform as expected. -- -- TEST FILES: -- The following files comprise this test: -- -- FA13A00.A -- CA13A01.A -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! -- Private child package of an elevator application. This package -- provides maintenance operations. private package FA13A00_1.CA13A01_4 is -- Maintenance operation One_Floor : Floor_No := 1; -- Type declared in parent. procedure Check_System; -- other type definitions and procedure declarations in real application. end FA13A00_1.CA13A01_4; --==================================================================-- -- Context clauses required for visibility needed by separate subunit. with FA13A00_0; -- Building Manager with FA13A00_1.FA13A00_2; -- Floor Calculation (private) with FA13A00_1.FA13A00_3; -- Move Elevator use FA13A00_0; package body FA13A00_1.CA13A01_4 is procedure Check_System is separate; end FA13A00_1.CA13A01_4; --==================================================================-- separate (FA13A00_1.CA13A01_4) -- Subunit Check_System declared in Maintenance Operation. procedure Check_System is begin -- See if regular power is on. if Power /= V120 then -- Reference package with'ed by TC_Operation := false; -- the subunit parent's body. end if; -- Test elevator function. FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of (Penthouse, Call_Waiting); -- the subunit parent's body. if not Call_Waiting (Penthouse) then -- Reference private part of the TC_Operation := false; -- parent of the subunit package's -- body. end if; FA13A00_1.FA13A00_2.Down (One_Floor); -- Reference private sibling of -- the subunit parent's body. if Current_Floor /= Floor'pred (Penthouse) then TC_Operation := false; -- Reference type declared in the end if; -- parent of the subunit parent's -- body. end Check_System; --==================================================================-- -- Public child package of an elevator application. This package provides -- an emergency operation. package FA13A00_1.CA13A01_5 is -- Emergency Operation -- Other type definitions in real application. procedure Emergency; private type Bell_Type is (Inactive, Active); end FA13A00_1.CA13A01_5; --==================================================================-- -- Context clauses required for visibility needed by separate subunit. with FA13A00_0; -- Building Manager with FA13A00_1.FA13A00_3; -- Move Elevator with FA13A00_1.CA13A01_4; -- Maintenance Operation (private) use FA13A00_0; package body FA13A00_1.CA13A01_5 is procedure Emergency is separate; end FA13A00_1.CA13A01_5; --==================================================================-- separate (FA13A00_1.CA13A01_5) -- Subunit Emergency declared in Maintenance Operation. procedure Emergency is Bell : Bell_Type; -- Reference type declared in the -- subunit parent's body. begin -- Calls maintenance operation. FA13A00_1.CA13A01_4.Check_System; -- Reference private sibling of the -- subunit parent 's body. -- Clear all calls to the elevator. Clear_Calls (Call_Waiting); -- Reference subprogram declared -- in the parent of the subunit -- parent's body. for I in Floor loop if Call_Waiting (I) then -- Reference private part of the TC_Operation := false; -- parent of the subunit parent's end if; -- body. end loop; -- Move elevator to the basement. FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of the (Basement, Call_Waiting); -- subunit parent's body. if Current_Floor /= Basement then -- Reference type declared in the TC_Operation := false; -- parent of the subunit parent's end if; -- body. -- Shut off power. Power := Off; -- Reference package with'ed by -- the subunit parent's body. -- Activate bell. Bell := Active; -- Reference type declared in the -- subunit parent's body. end Emergency; --==================================================================-- -- Public child subprogram of an elevator application. This subprogram -- provides an express operation. procedure FA13A00_1.CA13A01_6; --==================================================================-- -- Context clauses required for visibility needed by separate subunit. with FA13A00_0; -- Building Manager with FA13A00_1.FA13A00_2; -- Floor Calculation (private) with FA13A00_1.FA13A00_3; -- Move Elevator use FA13A00_0; procedure FA13A00_1.CA13A01_6 is -- Express Operation -- Other type definitions in real application. procedure GoTo_Penthouse is separate; begin GoTo_Penthouse; end FA13A00_1.CA13A01_6; --==================================================================-- separate (FA13A00_1.CA13A01_6) -- Subunit GoTo_Penthouse declared in Express Operation. procedure GoTo_Penthouse is begin -- Go faster. Power := V240; -- Reference package with'ed by -- the subunit parent's body. -- Call elevator. Call (Penthouse, Call_Waiting); -- Reference subprogram declared in -- the parent of the subunit -- parent's body. if not Call_Waiting (Penthouse) then -- Reference private part of the TC_Operation := false; -- parent of the subunit parent's end if; -- body. -- Move elevator to Penthouse. FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of the (Penthouse, Call_Waiting); -- subunit parent's body. if Current_Floor /= Penthouse then -- Reference type declared in the TC_Operation := false; -- parent of the subunit parent's end if; -- body. -- Return slowly while Current_Floor /= Floor1 loop -- Reference type, subprogram FA13A00_1.FA13A00_2.Down (1); -- declared in the parent of the -- subunit parent's body. end loop; if Current_Floor /= Floor1 then -- Reference type declared in TC_Operation := false; -- the parent of the subunit end if; -- parent's body. -- Back to normal. Power := V120; -- Reference package with'ed by -- the subunit parent's body. end GoTo_Penthouse; --==================================================================-- with FA13A00_1.CA13A01_5; -- Emergency Operation -- implicitly with Basic Elevator -- Operations with FA13A00_1.CA13A01_6; -- Express Operation with Report; procedure CA13A01 is begin Report.Test ("CA13A01", "Check that subunits declared in non-generic " & "child units of a public parent have the same visibility " & "into its parent, its parent's siblings, and packages on " & "which its parent depends"); -- Go to Penthouse. FA13A00_1.CA13A01_6; -- Call emergency operation. FA13A00_1.CA13A01_5.Emergency; if not FA13A00_1.TC_Operation then Report.Failed ("Incorrect elevator operation"); end if; Report.Result; end CA13A01;