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

diff --git a/gcc/testsuite/ada/acats/tests/c3/c393a02.a b/gcc/testsuite/ada/acats/tests/c3/c393a02.a
new file mode 100644
index 000000000..177bd34b8
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/c3/c393a02.a
@@ -0,0 +1,213 @@
+-- C393A02.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 a dispatching call to an abstract subprogram invokes
+--     the correct subprogram body of a descendant type according to
+--     the controlling tag.
+--     Check that a subprogram can be declared with formal parameters
+--     and result that are of an abstract type's associated class-wide
+--     type and that such subprograms can be called. 3.4.1(4)
+--
+-- TEST DESCRIPTION:
+--     This test declares several objects of types derived from the
+--     abstract type as defined in the foundation F393A00.  It then calls
+--     various dispatching and class-wide subprograms using those objects.
+--     The packages in F393A00 are instrumented to trace the flow of
+--     execution.
+--     The test checks for the correct order of execution, as expected
+--     by the various calls.
+--
+-- TEST FILES:
+--     The following files comprise this test:
+--
+--        F393A00.A   (foundation code)
+--        C393A02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      05 APR 96   SAIC    Update RM references for 2.1
+--
+--!
+
+with Report;
+with F393A00_0;
+with F393A00_1;
+with F393A00_2;
+with F393A00_3;
+with F393A00_4;
+procedure C393A02 is
+
+  A_Windmill : F393A00_2.Windmill;
+  A_Pump     : F393A00_3.Pump;
+  A_Mill     : F393A00_4.Mill;
+
+  A_Windmill_2 : F393A00_2.Windmill;
+  A_Pump_2     : F393A00_3.Pump;
+  A_Mill_2     : F393A00_4.Mill;
+
+  B_Windmill : F393A00_2.Windmill;
+  B_Pump     : F393A00_3.Pump;
+  B_Mill     : F393A00_4.Mill;
+
+  procedure Swapem( A,B: in out F393A00_2.Windmill'Class ) is
+  begin
+   F393A00_0.TC_Touch('x');
+   F393A00_2.Swap( A,B );
+  end Swapem;
+
+  function Zephyr( A: F393A00_2.Windmill'Class )
+           return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := A;
+  begin
+    F393A00_0.TC_Touch('y');
+    if not F393A00_1.Initialized( Item ) then  -- b
+      F393A00_2.Initialize( Item );            -- a
+    end if;
+    F393A00_2.Stop( Item );                    -- f / mff
+    F393A00_2.Add_Spin( Item, 10 );            -- e
+    return Item;
+  end Zephyr;
+
+  function Gale( It: F393A00_2.Windmill ) return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := It;
+  begin
+    F393A00_2.Stop( Item );                   -- f
+    F393A00_2.Add_Spin( Item, 40 );           -- e
+    return Item;
+  end Gale;
+
+  function Gale( It: F393A00_3.Pump ) return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := It;
+  begin 
+    F393A00_2.Stop( Item );                   -- f
+    F393A00_2.Add_Spin( Item, 50 );           -- e
+    return Item;
+  end Gale;
+
+  function Gale( It: F393A00_4.Mill ) return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := It;
+  begin 
+    F393A00_2.Stop( Item );                   -- mff
+    F393A00_2.Add_Spin( Item, 60 );           -- e
+    return Item;
+  end Gale;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C393A02", "Check that a dispatching call to an abstract "
+                         & "subprogram invokes the correct subprogram body. "
+                         & "Check that a subprogram declared with formal "
+                         & "parameters/result of an abstract type's "
+                         & "associated class-wide can be called" );
+
+  F393A00_0.TC_Validate( "hhh", "Mill declarations" );
+  A_Windmill := F393A00_2.Create;
+  F393A00_0.TC_Validate( "d", "Create A_Windmill" );
+
+  A_Pump     := F393A00_3.Create;
+  F393A00_0.TC_Validate( "h", "Create A_Pump" );
+
+  A_Mill     := F393A00_4.Create;
+  F393A00_0.TC_Validate( "hl", "Create A_Mill" );
+
+  --------------
+
+  Swapem( A_Windmill, A_Windmill_2 );
+  F393A00_0.TC_Validate( "xc", "Windmill Swap" );
+  
+  Swapem( A_Pump, A_Pump_2 );
+  F393A00_0.TC_Validate( "xc", "Pump Swap" );
+  
+  Swapem( A_Mill, A_Mill_2 );
+  F393A00_0.TC_Validate( "xk", "Pump Swap" );
+
+  F393A00_2.Initialize( A_Windmill_2 );  
+  F393A00_3.Initialize( A_Pump_2 );      
+  F393A00_4.Initialize( A_Mill_2 );      
+  B_Windmill := A_Windmill_2;
+  B_Pump     := A_Pump_2;
+  B_Mill     := A_Mill_2;                
+  F393A00_2.Add_Spin( B_Windmill, 123 ); 
+  F393A00_3.Set_Rate( B_Pump, 12.34 );   
+  F393A00_4.Add_Spin( B_Mill, 321 );     
+  F393A00_0.TC_Validate( "aaaeie", "Setting Values" );
+
+  declare
+    It : F393A00_2.Windmill'Class := Zephyr( B_Windmill ); -- ybfe
+    XX : F393A00_2.Windmill'Class := Gale( B_Windmill );   -- fe
+    use type F393A00_2.Rotational_Measurement;
+  begin
+    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+then
+      Report.Failed( "Copy to class-wide variable" );
+    end if;                                                -- bb
+    if F393A00_2.Spin( It ) /= 10                          -- g
+       or F393A00_2.Spin( XX ) /= 40 then                  -- g
+      Report.Failed( "Call to class-wide operation" );
+    end if;
+
+    F393A00_0.TC_Validate( "ybfefebbgg", "Windmill Zephyr" );
+  end;
+
+  declare
+    It : F393A00_2.Windmill'Class := Zephyr( B_Pump );     -- ybfe
+    XX : F393A00_2.Windmill'Class := Gale( B_Pump );       -- fe
+    use type F393A00_2.Rotational_Measurement;
+  begin
+    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+then
+      Report.Failed( "Bad copy to class-wide variable" );
+    end if;                                                -- bb
+    if F393A00_2.Spin( It ) /= 10                          -- g
+       or F393A00_2.Spin( XX ) /= 50 then                  -- g
+      Report.Failed( "Call to class-wide operation" );
+    end if;
+
+    F393A00_0.TC_Validate( "ybfefebbgg", "Pump Zephyr" );
+  end;
+
+  declare
+    It : F393A00_2.Windmill'Class := Zephyr( B_Mill );     -- ybmffe
+    XX : F393A00_2.Windmill'Class := Gale( B_Mill );       -- mffe
+    use type F393A00_2.Rotational_Measurement;
+  begin
+    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+then
+      Report.Failed( "Bad copy to class-wide variable" );
+    end if;                                                -- bb
+    if F393A00_2.Spin( It ) /= 10                          -- g
+       or F393A00_2.Spin( XX ) /= 60 then                  -- g
+      Report.Failed( "Call to class-wide operation" );
+    end if;
+
+    F393A00_0.TC_Validate( "ybmffemffebbgg", "Mill Zephyr" );
+  end;
+
+  Report.Result;
+
+end C393A02;