obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 419 insertions, 0 deletions

diff --git a/gcc/testsuite/ada/acats/tests/c3/c390003.a b/gcc/testsuite/ada/acats/tests/c3/c390003.a
new file mode 100644
index 000000000..643aad1cd
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/c3/c390003.a
@@ -0,0 +1,419 @@
+-- C390003.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.
+--*
+--
+-- OBJECTIVE:
+--     Check that for a subtype S of a tagged type T, S'Class denotes a
+--     class-wide subtype.  Check that T'Tag denotes the tag of the type T,
+--     and that, for a class-wide tagged type X, X'Tag denotes the tag of X.
+--     Check that the tags of stand alone objects, record and array
+--     components, aggregates, and formal parameters identify their type.
+--     Check that the tag of a value of a formal parameter is that of the
+--     actual parameter, even if the actual is passed by a view conversion.
+--
+-- TEST DESCRIPTION:
+--     This test defines a class hierarchy (based on C390002) and
+--     uses it to determine the correctness of the resulting tag
+--     information generated by the compiler.  A type is defined in the
+--     class which contains components of the class as part of its
+--     definition.  This is to reduce the overall number of types
+--     required, and to achieve the required nesting to accomplish
+--     this test.  The model is that of a car carrier truck; both car
+--     and truck being in the class of Vehicle.
+--
+--      Class Hierarchy:
+--                         Vehicle - - - - - - - (Bicycle)
+--                        /   |   \               /      \
+--                   Truck   Car   Q_Machine   Tandem  Motorcycle
+--                     |
+--                Auto_Carrier
+--      Contains:
+--                Auto_Carrier( Car )
+--                Q_Machine( Car, Motorcycle )
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed ARM references from objective text.
+--      20 Dec 94   SAIC    Replaced three unnecessary extension
+--                          aggregates with simple aggregates.
+--      16 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--!
+
+----------------------------------------------------------------- C390003_1
+
+with Ada.Tags;
+package C390003_1 is -- Vehicle
+
+  type TC_Keys is (Veh, MC, Tand, Car, Q, Truk, Heavy);
+  type States  is (Good, Flat, Worn);
+
+  type Wheel_List is array(Positive range <>) of States;
+
+  type Object(Wheels: Positive) is tagged record
+    Wheel_State : Wheel_List(1..Wheels);
+  end record;
+
+  procedure TC_Validate( It: Object; Key: TC_Keys );
+  procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag );
+
+  procedure Create( The_Vehicle : in out Object; Tyres : in States );
+  procedure Rotate( The_Vehicle : in out Object );
+  function  Wheels( The_Vehicle : Object ) return Positive;
+
+end C390003_1; -- Vehicle;
+
+----------------------------------------------------------------- C390003_2
+
+with C390003_1;
+package C390003_2 is -- Motivators
+
+  package Vehicle renames C390003_1;
+  subtype Bicycle is Vehicle.Object(2);  -- constrained subtype
+
+  type Motorcycle is new Bicycle with record
+    Displacement : Natural;
+  end record;
+  procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys );
+
+  type Tandem is new Bicycle with null record;
+  procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys );
+
+  type Car is new Vehicle.Object(4) with  -- extended, constrained
+    record
+      Displacement : Natural;
+    end record;
+  procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys );
+
+  type Truck is new Vehicle.Object with  -- extended, unconstrained
+    record
+      Tare : Natural;
+    end record;
+  procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys );
+
+end C390003_2; -- Motivators;
+
+----------------------------------------------------------------- C390003_3
+
+with C390003_1;
+with C390003_2;
+package C390003_3 is -- Special_Trucks
+  package Vehicle    renames C390003_1;
+  package Motivators renames C390003_2;
+  Max_Cars_On_Vehicle : constant := 6;
+  type Cargo_Index is range 0..Max_Cars_On_Vehicle;
+  type Cargo is array(Cargo_Index range 1..Max_Cars_On_Vehicle)
+                of Motivators.Car;
+  type Auto_Carrier is new Motivators.Truck(18) with
+    record
+      Load_Count : Cargo_Index := 0;
+      Payload    : Cargo;
+    end record;
+  procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys );
+  procedure Load  ( The_Car : in     Motivators.Car;
+                    Onto    : in out Auto_Carrier);
+  procedure Unload( The_Car :    out Motivators.Car;
+                    Off_of   : in out Auto_Carrier);
+end C390003_3;
+
+----------------------------------------------------------------- C390003_4
+
+with C390003_1;
+with C390003_2;
+package C390003_4 is -- James_Bond
+
+  package Vehicle   renames C390003_1;
+  package Motivators renames C390003_2;
+
+  type Q_Machine is new Vehicle.Object(4) with record
+    Car_Part  : Motivators.Car;
+    Bike_Part : Motivators.Motorcycle;
+  end record;
+  procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys );
+
+end C390003_4;
+
+----------------------------------------------------------------- C390003_1
+
+with Report;
+with Ada.Tags;
+package body C390003_1 is -- Vehicle
+
+  function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
+
+  procedure TC_Validate( It: Object; Key: TC_Keys ) is
+  begin
+    if Key /= Veh then
+      Report.Failed("Expected Veh Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag ) is
+  begin
+    if It'Tag /= The_Tag then
+      Report.Failed("Unexpected Tag for classwide formal");
+    end if;
+  end TC_Validate;
+
+  procedure Create( The_Vehicle : in out Object; Tyres : in States ) is
+  begin
+    The_Vehicle.Wheel_State := ( others => Tyres );
+  end Create;
+
+  function  Wheels( The_Vehicle : Object ) return Positive is
+  begin
+    return The_Vehicle.Wheels;
+  end Wheels;
+
+  procedure Rotate( The_Vehicle : in out Object ) is
+    Push : States;
+    Pulled : States
+         := The_Vehicle.Wheel_State(The_Vehicle.Wheel_State'Last);
+  begin
+    for Finger in
+        The_Vehicle.Wheel_State'First..The_Vehicle.Wheel_State'Last loop
+      Push := The_Vehicle.Wheel_State(Finger);
+      The_Vehicle.Wheel_State(Finger) := Pulled;
+      Pulled := Push;
+    end loop;
+  end Rotate;
+
+end C390003_1; -- Vehicle;
+
+----------------------------------------------------------------- C390003_2
+
+with Ada.Tags;
+with Report;
+package body C390003_2 is -- Motivators
+
+  function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+  function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+
+  procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.MC then
+      Report.Failed("Expected MC Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Tand then
+      Report.Failed("Expected Tand Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Car then
+      Report.Failed("Expected Car Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Truk then
+      Report.Failed("Expected Truk Key");
+    end if;
+  end TC_Validate;
+end C390003_2; -- Motivators;
+
+----------------------------------------------------------------- C390003_3
+
+with Ada.Tags;
+with Report;
+package body C390003_3 is -- Special_Trucks
+
+  function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+  function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+
+  procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Heavy then
+      Report.Failed("Expected Heavy Key");
+    end if;
+  end TC_Validate;
+
+  procedure Load  ( The_Car : in     Motivators.Car;
+                    Onto    : in out Auto_Carrier) is
+  begin
+    Onto.Load_Count := Onto.Load_Count +1;
+    Onto.Payload(Onto.Load_Count) := The_Car;
+  end Load;
+  procedure Unload( The_Car :    out Motivators.Car;
+                    Off_of   : in out Auto_Carrier) is
+  begin
+    The_Car := Off_of.Payload(Off_of.Load_Count);
+    Off_of.Load_Count := Off_of.Load_Count -1;
+  end Unload;
+
+end C390003_3;
+
+----------------------------------------------------------------- C390003_4
+
+with Report, Ada.Tags;
+package body C390003_4 is -- James_Bond
+
+  function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+  function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+
+  procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Q then
+      Report.Failed("Expected Q Key");
+    end if;
+  end TC_Validate;
+
+end C390003_4;
+
+------------------------------------------------------------------- C390003
+
+with Report;
+with C390003_1;
+with C390003_2;
+with C390003_3;
+with C390003_4;
+procedure C390003 is
+
+  package Vehicle        renames C390003_1;  use Vehicle;
+  package Motivators     renames C390003_2;
+  package Special_Trucks renames C390003_3;
+  package James_Bond     renames C390003_4;
+
+  -- The cast, in order of complexity:
+
+  Pennys_Bike : Motivators.Bicycle;
+  Weekender   : Motivators.Tandem;
+  Qs_Moped    : Motivators.Motorcycle;
+  Ms_Limo     : Motivators.Car;
+  Yard_Van    : Motivators.Truck(8);
+  Specter_X   : Special_Trucks.Auto_Carrier;
+  Gen_II      : James_Bond.Q_Machine;
+
+
+  -- Check compatibility with the corresponding class wide type.
+
+  procedure Vehicle_Shop( It  : in out Vehicle.Object'Class;
+                          Key : in     Vehicle.TC_Keys ) is
+
+    -- Check that Subtype'Class is defined for tagged subtypes.
+    procedure Bike_Shop( Bike: in out Motivators.Bicycle'Class ) is
+    begin
+        -- Dispatch to appropriate TC_Validate
+      Vehicle.TC_Validate( Bike, Key );
+    end Bike_Shop;
+
+  begin
+    Vehicle.TC_Validate( It, Key );
+    if Vehicle.Wheels( It ) = 2 then
+      Bike_Shop( It );  -- only call Bike_Shop when It has 2 wheels
+    end if;
+  end Vehicle_Shop;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C390003", "Check that for a subtype S of a tagged type " &
+               "T, S'Class denotes a class-wide subtype.  Check that " &
+               "T'Tag denotes the tag of the type T, and that, for a " &
+               "class-wide tagged type X, X'Tag denotes the tag of X.  " &
+               "Check that the tags of stand alone objects, record and " &
+               "array components, aggregates, and formal parameters " &
+               "identify their type. Check that the tag of a value of a " &
+               "formal parameter is that of the actual parameter, even " &
+               "if the actual is passed by a view conversion" );
+
+--     Check that the tags of stand alone objects, record and array
+--     components, aggregates, and formal parameters identify their type.
+--     Check that the tag of a value of a formal parameter is that of the
+--     actual parameter, even if the actual is passed by a view conversion.
+
+  Vehicle_Shop( Pennys_Bike,          Veh );
+  Vehicle_Shop( Weekender,            Tand );
+  Vehicle_Shop( Qs_Moped,             MC );
+  Vehicle_Shop( Ms_Limo,              Car );
+  Vehicle_Shop( Yard_Van,             Truk );
+  Vehicle_Shop( Specter_X,            Heavy );
+  Vehicle_Shop( Specter_X.Payload(1), Car );
+  Vehicle_Shop( Gen_II,               Q );
+  Vehicle_Shop( Gen_II.Car_Part,      Car );
+  Vehicle_Shop( Gen_II.Bike_Part,     MC );
+
+  Vehicle.TC_Validate( Pennys_Bike, Vehicle.Object'Tag );
+  Vehicle.TC_Validate( Weekender,   Motivators.Tandem'Tag );
+  Vehicle.TC_Validate( Qs_Moped,    Motivators.Motorcycle'Tag );
+  Vehicle.TC_Validate( Ms_Limo,     Motivators.Car'Tag );
+  Vehicle.TC_Validate( Yard_Van,    Motivators.Truck'Tag );
+  Vehicle.TC_Validate( Specter_X,   Special_Trucks.Auto_Carrier'Tag );
+  Vehicle.TC_Validate( Specter_X.Payload(1), Motivators.Car'Tag );
+  Vehicle.TC_Validate( Gen_II,              James_Bond.Q_Machine'Tag );
+  Vehicle.TC_Validate( Gen_II.Car_Part,     Motivators.Car'Tag );
+  Vehicle.TC_Validate( Gen_II.Bike_Part,    Motivators.Motorcycle'Tag );
+
+-- Check the tag generated for an aggregate.
+
+  Rentals: declare
+    Mikes_Rental : Vehicle.Object'Class :=
+                     Vehicle.Object'( 3, (Good, Flat, Worn));
+    Diannes_Car  : Vehicle.Object'Class :=
+                      Motivators.Tandem'( Wheels      => 2, 
+                                          Wheel_State => (Good, Good) );
+    Jims_Bike    : Vehicle.Object'Class :=
+                      Motivators.Motorcycle'( Pennys_Bike
+                                              with Displacement => 350 );
+    Bills_Limo   : Vehicle.Object'Class :=
+                      Motivators.Car'( Wheels       => 4,
+                                       Wheel_State  => (others => Good),
+                                       Displacement => 282 );
+    Alans_Car    : Vehicle.Object'Class :=
+                      Motivators.Truck'( 18, (others => Worn),
+                                         Tare => 5_500 );
+    Pats_Truck   : Vehicle.Object'Class := Specter_X;
+    Keiths_Car   : Vehicle.Object'Class := Gen_II;
+    Isaacs_Bus   : Vehicle.Object'Class := Keiths_Car;
+
+  begin
+    Vehicle.TC_Validate( Mikes_Rental, Vehicle.Object'Tag );
+    Vehicle.TC_Validate( Diannes_Car,  Motivators.Tandem'Tag );
+    Vehicle.TC_Validate( Jims_Bike,    Motivators.Motorcycle'Tag );
+    Vehicle.TC_Validate( Bills_Limo,   Motivators.Car'Tag );
+    Vehicle.TC_Validate( Alans_Car,    Motivators.Truck'Tag );
+    Vehicle.TC_Validate( Pats_Truck,   Special_Trucks.Auto_Carrier'Tag );
+    Vehicle.TC_Validate( Keiths_Car,   James_Bond.Q_Machine'Tag );
+  end Rentals;
+
+-- Check the tag of parameters.
+-- Check that the tag is not affected by view conversion.
+
+  Vehicle.TC_Validate( Vehicle.Object( Gen_II  ), James_Bond.Q_Machine'Tag );
+  Vehicle.TC_Validate( Vehicle.Object( Ms_Limo ), Motivators.Car'Tag );
+  Vehicle.TC_Validate( Motivators.Bicycle( Weekender ),
+                       Motivators.Tandem'Tag );
+  Vehicle.TC_Validate( Motivators.Bicycle( Gen_II.Bike_Part ),
+                       Motivators.Motorcycle'Tag );
+
+  Report.Result;
+
+end C390003;