diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c3900011.am')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c3900011.am | 253 |
1 files changed, 253 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c3900011.am b/gcc/testsuite/ada/acats/tests/c3/c3900011.am new file mode 100644 index 000000000..68207f32a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c3/c3900011.am @@ -0,0 +1,253 @@ +-- C3900011.AM +-- +-- 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 a record extension can be declared in the same package +-- as its parent, and that this parent may be a tagged record or a +-- record extension. Check that each derivative inherits all user- +-- defined primitive subprograms of its parent (including those that +-- its parent inherited), and that it may declare its own primitive +-- subprograms. +-- +-- Check that predefined equality operators are defined for the root +-- tagged type. +-- +-- Check that type conversion is defined from a type extension to its +-- parent, and that this parent itself may be a type extension. +-- +-- TEST DESCRIPTION: +-- Declare a root tagged type in a package specification. Declare two +-- primitive subprograms for the type. +-- +-- Extend the root type with a record extension in the same package +-- specification. Declare a new primitive subprogram for the extension +-- (in addition to its two inherited subprograms). +-- +-- Extend the extension with a record extension in the same package +-- specification. Declare a new primitive subprogram for this second +-- extension (in addition to its three inherited subprograms). +-- +-- In the main program, declare operations for the root tagged type which +-- utilize aggregates and equality operators to verify the correctness +-- of the components. Overload these operations for the two type +-- extensions. Within each of these overloading operations, utilize type +-- conversion to call the parent's implementation of the same operation. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- C3900010.A +-- => C3900011.AM +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +with C3900010; +with Report; +procedure C3900011 is + + + package Check_Alert_Values is + + -- Declare functions to verify correctness of tagged record components + -- before and after calls to their primitive subprograms. + + + -- Alert_Type: + + function Initial_Values_Okay (A : in C3900010.Alert_Type) + return Boolean; + + function Bad_Final_Values (A : in C3900010.Alert_Type) + return Boolean; + + + -- Low_Alert_Type: + + function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type) + return Boolean; + + function Bad_Final_Values (LA : in C3900010.Low_Alert_Type) + return Boolean; + + + -- Medium_Alert_Type: + + function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type) + return Boolean; + + function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type) + return Boolean; + + + end Check_Alert_Values; + + + --==========================================================-- + + + package body Check_Alert_Values is + + + function Initial_Values_Okay (A : in C3900010.Alert_Type) + return Boolean is + use type C3900010.Alert_Type; + begin -- "=" operator availability. + return (A = (Arrival_Time => C3900010.Default_Time, + Display_On => C3900010.Null_Device)); + end Initial_Values_Okay; + + + function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type) + return Boolean is + begin -- Type conversion. + return (Initial_Values_Okay (C3900010.Alert_Type (LA)) and + LA.Level = 0); + end Initial_Values_Okay; + + + function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type) + return Boolean is + use type C3900010.Person_Enum; + begin -- Type conversion. + return (Initial_Values_Okay (C3900010.Low_Alert_Type (MA)) and + MA.Action_Officer = C3900010.Nobody); + end Initial_Values_Okay; + + + function Bad_Final_Values (A : in C3900010.Alert_Type) + return Boolean is + use type C3900010.Alert_Type; + begin -- "/=" operator availability. + return (A /= (Arrival_Time => C3900010.Alert_Time, + Display_On => C3900010.Null_Device)); + end Bad_Final_Values; + + + function Bad_Final_Values (LA : in C3900010.Low_Alert_Type) + return Boolean is + use type C3900010.Low_Alert_Type; + begin -- "=" operator availability. + return not ( LA = (Arrival_Time => C3900010.Alert_Time, + Display_On => C3900010.Teletype, + Level => 1) ); + end Bad_Final_Values; + + + function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type) + return Boolean is + use type C3900010.Medium_Alert_Type; + begin -- "/=" operator availability. + return ( MA /= (C3900010.Alert_Time, + C3900010.Console, + 1, + C3900010.Duty_Officer) ); + end Bad_Final_Values; + + + end Check_Alert_Values; + + + --==========================================================-- + + + use Check_Alert_Values; + use C3900010; + + Root_Alarm : C3900010.Alert_Type; + Low_Alarm : C3900010.Low_Alert_Type; + Medium_Alarm : C3900010.Medium_Alert_Type; + +begin + + Report.Test ("C390001", "Primitive operation inheritance by type " & + "extensions: all extensions declared in same package " & + "as parent"); + + +-- Check root tagged type: + + if Initial_Values_Okay (Root_Alarm) then + Handle (Root_Alarm); -- Explicitly declared. + Display (Root_Alarm); -- Explicitly declared. + + if Bad_Final_Values (Root_Alarm) then + Report.Failed ("Wrong results after Alert_Type calls"); + end if; + else + Report.Failed ("Wrong initial values for Alert_Type"); + end if; + + +-- Check record extension of root tagged type: + + if Initial_Values_Okay (Low_Alarm) then + Handle (Low_Alarm); -- Inherited. + Low_Alarm.Display_On := Teletype; + Display (Low_Alarm); -- Inherited. + Low_Alarm.Level := Level_Of (Low_Alarm); -- Explicitly declared. + + if Bad_Final_Values (Low_Alarm) then + Report.Failed ("Wrong results after Low_Alert_Type calls"); + end if; + else + Report.Failed ("Wrong initial values for Low_Alert_Type"); + end if; + + +-- Check record extension of record extension: + + if Initial_Values_Okay (Medium_Alarm) then + Handle (Medium_Alarm); -- Inherited twice. + Medium_Alarm.Display_On := Console; + Display (Medium_Alarm); -- Inherited twice. + Medium_Alarm.Level := Level_Of (Medium_Alarm); -- Inherited. + Assign_Officer (Medium_Alarm, Duty_Officer); -- Explicitly declared. + + if Bad_Final_Values (Medium_Alarm) then + Report.Failed ("Wrong results after Medium_Alert_Type calls"); + end if; + else + Report.Failed ("Wrong initial values for Medium_Alert_Type"); + end if; + + +-- Check final display counts: + + if C3900010.Display_Count_For /= (Null_Device => 1, + Teletype => 1, + Console => 1, + Big_Screen => 0) + then + Report.Failed ("Wrong final values for display counts"); + end if; + + + Report.Result; + +end C3900011; |