-- C393007.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. --* -- -- TEST OBJECTIVE: -- Check that an extended type can be derived from an abstract type, -- where the abstract type is defined in a package, and the type derived -- from it is defined in a distinct library package. -- -- TEST DESCRIPTION: -- Declare an private (abstract) type; declare two primitive operations -- of the type that are explicitly abstract. -- Derive an extended type from the (private) abstract type, overriding -- both of the primitive operations. -- This test also checks to see that name overloading between abstract -- and non-abstract functions is resolved correctly. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! package C393007_0 is -- Alert_System type DT_Type is new Integer; type Alert_Type is abstract tagged record Time_Of_Arrival : DT_Type; end record; type Log_File_Type is range 0 .. 100; Procedure Handle (A : in out Alert_type) is abstract; procedure Log (A : Alert_Type; L : in out Log_File_Type) is abstract; procedure Set_Time (A : in out Alert_Type); function Correct_Time_Stamp (A : Alert_Type) return Boolean; Day_Time : DT_Type := 100; end C393007_0; -- Alert_System; --=======================================================================-- package body C393007_0 is -- Alert_System function Time_Stamp return DT_Type is begin Day_Time := Day_Time + 1; return Day_Time; end Time_Stamp; procedure Set_Time (A : in out Alert_Type) is begin A.Time_Of_Arrival := Time_Stamp; end Set_time; function Correct_Time_Stamp ( A : Alert_Type) return Boolean is begin return (A.Time_Of_Arrival = Day_Time); end Correct_Time_Stamp; end C393007_0; -- Alert_System; --=======================================================================-- with Report; with C393007_0; -- Alert_system; package C393007_1 is type Normal_Alert_Type is new C393007_0.Alert_Type with null record; Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First; procedure Handle (A : in out Normal_Alert_Type); -- Override is required procedure Log (A : Normal_Alert_Type; -- Override is required L : in out C393007_0.Log_File_Type); end C393007_1; package body C393007_1 is use type C393007_0.Log_File_Type; procedure Handle (A : in out Normal_Alert_Type) is begin Set_Time (A); Log (A, Log_File); end Handle; procedure Log (A : Normal_Alert_Type; L : in out C393007_0.Log_File_Type) is begin L := C393007_0."+"(L, 1); end Log; end C393007_1; with Report; with C393007_0; with C393007_1; -- Alert_system; procedure C393007 is use C393007_0; use C393007_1; Alert_One : C393007_1.Normal_Alert_Type; begin Report.Test ("C393007", "Check that an extended type can be derived " & "from an abstract type"); Handle (Alert_One); if not Correct_Time_Stamp (Alert_One) then Report.Failed ("Wrong results from procedure Handle"); end if; if Log_File /=1 then Report.Failed ("Wrong results"); end if; Report.Result; end C393007;