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, 245 insertions, 0 deletions

diff --git a/gcc/testsuite/ada/acats/support/f393a00.a b/gcc/testsuite/ada/acats/support/f393a00.a
new file mode 100644
index 000000000..e85c3f49c
--- /dev/null
+++ b/gcc/testsuite/ada/acats/support/f393a00.a
@@ -0,0 +1,245 @@
+-- F393A00.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.
+--*
+--
+-- FOUNDATION DESCRIPTION:
+--      This foundation provides a simple background for a class family
+--      based on an abstract type.  It is to be used to test the
+--      dispatching of various forms of subprogram defined/inherited and
+--      overridden with the abstract type.
+--
+--  type                       procedures                  functions
+--  ----                       ----------                  ---------
+--  Object                     Initialize, Swap(abstract)  Create(abstract)
+--        Object'Class                                     Initialized
+--    Windmill is new Object   Swap, Stop, Add_Spin        Create, Spin
+--      Pump is new Windmill   Set_Rate                    Create, Rate
+--      Mill is new Windmill   Swap, Stop                  Create
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+ 
+package F393A00_0 is
+   procedure TC_Touch ( A_Tag : Character );
+   procedure TC_Validate( Expected: String; Message: String );
+end F393A00_0;
+ 
+with Report;
+package body F393A00_0 is
+   Expectation : String(1..20);
+   Finger      : Natural := 0;
+ 
+   procedure TC_Touch ( A_Tag : Character ) is
+   begin
+     Finger := Finger+1;
+     Expectation(Finger) := A_Tag;
+   end TC_Touch;
+ 
+   procedure TC_Validate( Expected: String; Message: String ) is
+   begin
+     if Expectation(1..Finger) /= Expected then
+       Report.Failed( Message & " Expecting: " & Expected 
+ 			     & " Got: " & Expectation(1..Finger) );
+     end if;
+     Finger := 0;
+   end TC_Validate;
+end F393A00_0;
+ 
+----------------------------------------------------------------------
+ 
+package F393A00_1 is
+   type Object is abstract tagged private;
+   procedure Initialize( An_Object: in out Object );
+   function  Initialized( An_Object: Object'Class ) return Boolean;
+   procedure Swap( A,B: in out Object ) is abstract;
+   function  Create return Object is abstract;
+private
+   type Object is abstract tagged record
+     Initialized : Boolean := False;
+   end record;
+end F393A00_1;
+ 
+with F393A00_0;
+package body F393A00_1 is
+   procedure Initialize( An_Object: in out Object ) is
+   begin
+     An_Object.Initialized := True;
+     F393A00_0.TC_Touch('a');
+   end Initialize;
+ 
+   function  Initialized( An_Object: Object'Class ) return Boolean is
+   begin
+     F393A00_0.TC_Touch('b');
+     return An_Object.Initialized;
+   end Initialized;
+end F393A00_1;
+ 
+----------------------------------------------------------------------
+ 
+with F393A00_1;
+package F393A00_2 is
+ 
+   type Rotational_Measurement is range -1_000 .. 1_000;
+   type Windmill is new F393A00_1.Object with private;
+ 
+   procedure Swap( A,B: in out Windmill );  
+ 
+   function  Create return Windmill;        
+ 
+   procedure Add_Spin( To_Mill : in out Windmill;
+ 		      RPMs    : in     Rotational_Measurement );
+ 
+   procedure Stop( Mill : in out Windmill );
+ 
+   function  Spin( Mill : Windmill ) return Rotational_Measurement;
+ 
+private
+   type Windmill is new F393A00_1.Object with
+     record
+       Spin : Rotational_Measurement := 0;
+     end record;
+end F393A00_2;
+ 
+with F393A00_0;
+package body F393A00_2 is
+ 
+   procedure Swap( A,B: in out Windmill ) is
+     T : constant Windmill := B;
+   begin
+     F393A00_0.TC_Touch('c');
+     B := A;
+     A := T;
+   end Swap;
+ 
+   function  Create return Windmill is
+     A_Mill : Windmill;
+   begin
+     F393A00_0.TC_Touch('d');
+     return A_Mill;
+   end Create;
+ 
+   procedure Add_Spin( To_Mill : in out Windmill;
+ 		      RPMs    : in     Rotational_Measurement ) is
+   begin
+     F393A00_0.TC_Touch('e');
+     To_Mill.Spin := To_Mill.Spin + RPMs;
+   end Add_Spin;
+ 
+   procedure Stop( Mill : in out Windmill ) is
+   begin
+     F393A00_0.TC_Touch('f');
+     Mill.Spin := 0;
+   end Stop;
+ 
+   function  Spin( Mill : Windmill ) return Rotational_Measurement is
+   begin
+     F393A00_0.TC_Touch('g');
+     return Mill.Spin;
+   end Spin;
+ 
+end F393A00_2;
+ 
+----------------------------------------------------------------------
+ 
+with F393A00_2;
+package F393A00_3 is
+   type Pump is new F393A00_2.Windmill with private;
+   function Create return Pump;
+ 
+   type Gallons_Per_Revolution is digits 3;
+   procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution);
+   function  Rate( Of_Pump: Pump ) return Gallons_Per_Revolution;
+private
+   type Pump is new F393A00_2.Windmill with
+     record
+       GPRPM : Gallons_Per_Revolution := 0.0; -- Gallons/RPM
+     end record;
+end F393A00_3;
+ 
+with F393A00_0;
+package body F393A00_3 is
+   function Create return Pump is
+     Sump : Pump;
+   begin
+     F393A00_0.TC_Touch('h');
+     return Sump;
+   end Create;
+ 
+   procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution)
+   is
+   begin
+     F393A00_0.TC_Touch('i');
+     A_Pump.GPRPM := To_Rate;
+   end Set_Rate;
+ 
+   function  Rate( Of_Pump: Pump ) return Gallons_Per_Revolution is
+   begin
+     F393A00_0.TC_Touch('j');
+     return Of_Pump.GPRPM;
+   end Rate;
+end F393A00_3;
+ 
+----------------------------------------------------------------------
+
+with F393A00_2;
+with F393A00_3;
+package F393A00_4 is
+   type Mill is new F393A00_2.Windmill with private;
+ 
+   procedure Swap( A,B: in out Mill );
+   function  Create return Mill;
+   procedure Stop( It: in out Mill );
+ private
+   type Mill is new F393A00_2.Windmill with
+     record
+       Pump: F393A00_3.Pump := F393A00_3.Create;
+     end record;
+end F393A00_4;
+ 
+with F393A00_0;
+package body F393A00_4 is
+   procedure Swap( A,B: in out Mill ) is
+     T: constant Mill := A;
+   begin
+     F393A00_0.TC_Touch('k');
+     A := B;
+     B := T;
+   end Swap;
+ 
+   function  Create return Mill is
+     A_Mill : Mill;
+   begin
+     F393A00_0.TC_Touch('l');
+     return A_Mill;
+   end Create;
+ 
+   procedure Stop( It: in out Mill ) is
+   begin
+     F393A00_0.TC_Touch('m');
+     F393A00_3.Stop( It.Pump ); 
+     F393A00_2.Stop( F393A00_2.Windmill( It ) ); 
+   end Stop;
+end F393A00_4;