1 files changed, 0 insertions, 201 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c393a06.a b/gcc/testsuite/ada/acats/tests/c3/c393a06.a
deleted file mode 100644
index c257d5fa0a0..00000000000
--- a/gcc/testsuite/ada/acats/tests/c3/c393a06.a
+++ /dev/null
@@ -1,201 +0,0 @@
--- 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;
-