-- C393011.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 abstract extended type can be derived from an abstract -- type, and that a a non-abstract type may then be derived from the -- second abstract type. -- -- TEST DESCRIPTION: -- Define an abstract type with three primitive operations, two of them -- abstract. Derive an extended type from it, inheriting the non- -- abstract operation, overriding one of the abstract operations with -- a non-abstract operation, and overriding the other abstract operation -- with an abstract operation. The extended type is therefore abstract; -- derive an extended type from it. Override the abstract operation with -- a non-abstract operation; inherit one operation from the original -- abstract type, and inherit one operation from the intermediate -- abstract type. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! Package C393011_0 is -- Definitions type Status_Enum is (None, Unhandled, Pending, Handled); type Serial_Type is new Integer range 0 .. Integer'Last; subtype Priority_Type is Integer range 0..10; type Display_Enum is (Bit_Bucket, TTY, Console, Big_Screen); Next : Serial_Type := 1; Display_Device : Display_Enum := Bit_Bucket; end C393011_0; -- Definitions; --=======================================================================-- with C393011_0; -- Definitions Package C393011_1 is -- Alert package Definitions renames C393011_0; type Alert_Type is abstract tagged record Status : Definitions.Status_Enum := Definitions.None; Serial_Num : Definitions.Serial_Type := 0; Priority : Definitions.Priority_Type; end record; -- Alert_Type is an abstract type with -- two operations to be overridden procedure Set_Status ( A : in out Alert_Type; -- not abstract To : Definitions.Status_Enum); procedure Set_Serial ( A : in out Alert_Type) is abstract; procedure Display ( A : Alert_Type) is abstract; end C393011_1; -- Alert --=======================================================================-- with C393011_0; package body C393011_1 is -- Alert procedure Set_Status ( A : in out Alert_Type; To : Definitions.Status_Enum) is begin A.Status := To; end Set_Status; end C393011_1; -- Alert; --=======================================================================-- with C393011_0, -- Definitions, C393011_1, -- Alert, Calendar; Package C393011_3 is -- New_Alert type New_Alert_Type is abstract new C393011_1.Alert_Type with record Display_Dev : C393011_0.Display_Enum := C393011_0.TTY; end record; -- procedure Set_Status is inherited procedure Set_Serial ( A : in out New_Alert_Type); -- override/see body procedure Display ( A : New_Alert_Type) is abstract; -- override is abstract -- still can't declare objects of New_Alert_Type end C393011_3; -- New_Alert --=======================================================================-- with C393011_0; Package Body C393011_3 is -- New_Alert package Definitions renames C393011_0; procedure Set_Serial (A : in out New_Alert_Type) is use type Definitions.Serial_Type; begin A.Serial_Num := Definitions.Next; Definitions.Next := Definitions."+"( Definitions.Next, 1); end Set_Serial; End C393011_3; -- New_Alert; --=======================================================================-- with C393011_0, -- Definitions C393011_3; -- New_Alert -- package Alert is not visible package C393011_4 is package New_Alert renames C393011_3; package Definitions renames C393011_0; type Final_Alert_Type is new New_Alert.New_Alert_Type with null record; -- inherits Set_Status including body -- inherits Set_Serial including body -- must override Display since inherited Display is abstract procedure Display(FA : in Final_Alert_Type); procedure Handle (FA : in out Final_Alert_Type); end C393011_4; package body C393011_4 is procedure Display (FA : in Final_Alert_Type) is begin Definitions.Display_Device := FA.Display_Dev; end Display; procedure Handle (FA : in out Final_Alert_Type) is begin Set_Status (FA, Definitions.Handled); Set_Serial (FA); Display (FA); end Handle; end C393011_4; with C393011_0, -- Definitions C393011_3; -- New_Alert -- package Alert is not visible with C393011_4; with Report; procedure C393011 is use C393011_4; use Definitions; FA : Final_Alert_Type; begin Report.Test ("C393011", "Check that an extended type can be derived " & "from an abstract type"); if (Definitions.Display_Device /= Definitions.Bit_Bucket) or (Definitions.Next /= 1) or (FA.Status /= Definitions.None) or (FA.Serial_Num /= 0) or (FA.Display_Dev /= TTY) then Report.Failed ("Incorrect initial conditions"); end if; Handle (FA); if (Definitions.Display_Device /= Definitions.TTY) or (Definitions.Next /= 2) or (FA.Status /= Definitions.Handled) or (FA.Serial_Num /= 1) or (FA.Display_Dev /= TTY) then Report.Failed ("Incorrect results from Handle"); end if; Report.Result; end C393011;