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

diff --git a/gcc/testsuite/ada/acats/tests/c3/c393a06.a b/gcc/testsuite/ada/acats/tests/c3/c393a06.a
new file mode 100644
index 000000000..c257d5fa0
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/c3/c393a06.a
@@ -0,0 +1,201 @@
+-- C393A06.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 type that inherits abstract operations but
+--      overrides each of these operations is not required to be
+--      abstract, and that objects of the type and its class-wide type
+--      may be declared and passed in calls to the overriding
+--      subprograms.
+--
+-- TEST DESCRIPTION:
+--      This test derives a type from the root abstract type available
+--      in foundation F393A00.  It declares subprograms as required by
+--      the language to override the abstract subprograms, allowing the
+--      derived type itself to be not abstract.  It also declares
+--      operations on the new type, as well as on the associated class-
+--      wide type.  The main program then uses two objects of the type
+--      and two objects of the class-wide type as parameters for each of
+--      the subprograms.  Correct execution is determined by path
+--      analysis and value checking.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F393A00.A   (foundation code)
+--         C393A06.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--
+--!
+ 
+ with F393A00_1;
+ package C393A06_0 is
+   type Organism is new F393A00_1.Object with private;
+   type Kingdoms is ( Animal, Vegetable, Unspecified );
+ 
+   procedure Swap( A,B: in out Organism );
+   function  Create return Organism;
+ 
+   procedure Initialize( The_Entity     : in out Organism;
+                         In_The_Kingdom : Kingdoms );
+   function  Kingdom( Of_The_Entity : Organism ) return Kingdoms;
+ 
+   procedure TC_Check( An_Entity   : Organism'Class;
+                       In_Kingdom  : Kingdoms;
+                       Initialized : Boolean );
+ 
+   Incompatible : exception;
+ 
+ private
+   type Organism is new F393A00_1.Object with
+     record
+       In_Kingdom : Kingdoms;
+     end record;
+ end C393A06_0;
+ 
+ with F393A00_0;
+ package body C393A06_0 is
+ 
+   procedure Swap( A,B: in out Organism ) is
+   begin
+     F393A00_0.TC_Touch( 'A' );  ------------------------------------------- A
+     if A.In_Kingdom /= B.In_Kingdom then
+       F393A00_0.TC_Touch( 'X' );
+       raise Incompatible;
+     else
+       declare
+         T: constant Organism := A;
+       begin
+         A := B;
+         B := T;
+       end;
+     end if;
+   end Swap;
+ 
+   function  Create return Organism is
+     Widget : Organism;
+   begin
+     F393A00_0.TC_Touch( 'B' ); ------------------------------------------- B
+     Initialize( Widget );
+     Widget.In_Kingdom := Unspecified;
+     return Widget;
+   end Create;
+ 
+   procedure Initialize( The_Entity     : in out Organism;
+                         In_The_Kingdom : Kingdoms ) is
+   begin
+     F393A00_0.TC_Touch( 'C' ); ------------------------------------------- C
+     F393A00_1.Initialize( F393A00_1.Object( The_Entity ) );
+     The_Entity.In_Kingdom := In_The_Kingdom;
+   end Initialize;
+ 
+   function  Kingdom( Of_The_Entity : Organism ) return Kingdoms is
+   begin
+     F393A00_0.TC_Touch( 'D' ); ------------------------------------------- D
+     return Of_The_Entity.In_Kingdom;
+   end Kingdom;
+ 
+   procedure TC_Check( An_Entity   : Organism'Class;
+                       In_Kingdom  : Kingdoms;
+                       Initialized : Boolean ) is
+   begin
+     if F393A00_1.Initialized( An_Entity ) /= Initialized then
+       F393A00_0.TC_Touch( '-' ); ------------------------------------------- -
+     elsif An_Entity.In_Kingdom /= In_Kingdom then
+       F393A00_0.TC_Touch( '!' ); ------------------------------------------- !
+     else
+       F393A00_0.TC_Touch( '+' ); ------------------------------------------- +
+     end if;
+   end TC_Check;
+ 
+ end C393A06_0;
+ 
+ with Report;
+ 
+ with C393A06_0;
+ with F393A00_0;
+ with F393A00_1;
+ procedure C393A06 is
+ 
+   package Darwin  renames C393A06_0;
+   package Tagger  renames F393A00_0;
+   package Objects renames F393A00_1;
+ 
+   Lion      : Darwin.Organism;
+   Tigerlily : Darwin.Organism;
+   Bear      : Darwin.Organism'Class := Darwin.Create;
+   Sunflower : Darwin.Organism'Class := Darwin.Create;
+ 
+   use type Darwin.Kingdoms;
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C393A06", "Check that a type that inherits abstract "
+                          & "operations but overrides each of these "
+                          & "operations is not required to be abstract. "
+                          & "Check that objects of the type and its "
+                          & "class-wide type may be declared and passed "
+                          & "in calls to the overriding subprograms" );
+ 
+   Tagger.TC_Validate( "BaBa", "Declaration Initializations" );
+ 
+   Darwin.Initialize( Lion,      Darwin.Animal );
+   Darwin.Initialize( Tigerlily, Darwin.Vegetable );
+   Darwin.Initialize( Bear,      Darwin.Animal );
+   Darwin.Initialize( Sunflower, Darwin.Vegetable );
+ 
+   Tagger.TC_Validate( "CaCaCaCa", "Initialization sequence" );
+ 
+   Oh_My: begin
+     Darwin.Swap( Lion, Darwin.Organism( Bear ) );
+     Darwin.Swap( Lion, Tigerlily );
+     Report.Failed("Exception not raised");
+   exception
+     when Darwin.Incompatible => null;
+   end Oh_My;
+ 
+   Tagger.TC_Validate( "AAX", "Swap sequence" );
+ 
+   if Darwin.Kingdom( Darwin.Create ) = Darwin.Unspecified then
+     Darwin.Swap( Sunflower, Darwin.Organism'Class( Tigerlily ) );
+   end if;
+ 
+   Tagger.TC_Validate( "BaDA", "Vegetable swap sequence" );
+ 
+   Darwin.TC_Check( Lion,      Darwin.Animal,    True );
+   Darwin.TC_Check( Tigerlily, Darwin.Vegetable, True );
+   Darwin.TC_Check( Bear,      Darwin.Animal,    True );
+   Darwin.TC_Check( Sunflower, Darwin.Vegetable, True );
+ 
+   Tagger.TC_Validate( "b+b+b+b+", "Final sequence" );
+ 
+   Report.Result;
+ 
+ end C393A06;
+