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