diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c393011.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c393011.a | 220 |
1 files changed, 0 insertions, 220 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c393011.a b/gcc/testsuite/ada/acats/tests/c3/c393011.a deleted file mode 100644 index 8741e87c1c4..00000000000 --- a/gcc/testsuite/ada/acats/tests/c3/c393011.a +++ /dev/null @@ -1,220 +0,0 @@ --- 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; - |