From patchwork Mon Oct  4 13:17:35 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Ada] Overriding inherited functions of null extensions
From: Arnaud Charlet <charlet@adacore.com>
X-Patchwork-Id: 66650
Message-Id: <20101004131735.GA17876@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 4 Oct 2010 15:17:35 +0200

In Ada2005, a function with controlling result whose return type is a null
extension is not abstract, and the compiler creates a wrapper body for it when
the type is frozen.  If a later body overrides the inherited operation, the
wrapper body must be removed from the tree. The overriding may take place
before the wrapper is generated, for example through a function declaration
or a subprogram renaming,  in which case there is no wrapper body to delete.

The following must compile quietly:

   gcc -c -gnat05 wrapper.adb

---
with Gen;
package Wrapper is
   type Str is access all String;
   package Inst is new Gen (Str);
   type Value is new Inst.T with null record;
   function Create (It : String) return Value;
   function "+" (It : String) return Value renames Create;
end;
---
package body Wrapper is
   function Create (It : String) return Value is
      Thing : Value;
   begin
      return Thing;
   end Create;
end;
---
generic
   type Elem is private;
package Gen is
   type T is tagged null record;
   function Create (It : String) return T;
   function "+" (It : String) return T renames Create;
end;
---
package body  Gen is
   function Create (It : String) return T is
      Thing : T;
   begin
      return Thing;
   end;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Find_Corresponding_Spec): Check that the wrapper body is
	present before deleting from the tree, when an inherited function with
	a controlling result that returns a null extension is overridden by a
	later declaration or body.

Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 164906)
+++ sem_ch6.adb	(working copy)
@@ -5910,8 +5910,8 @@ package body Sem_Ch6 is
                --  that was created for an operation inherited by a null
                --  extension, it may be overridden by a body without a previous
                --  spec (one more reason why these should be shunned). In that
-               --  case remove the generated body, because the current one is
-               --  the explicit overriding.
+               --  case remove the generated body if present, because the
+               --  current one is the explicit overriding.
 
                elsif Ekind (E) = E_Function
                  and then Ada_Version >= Ada_05
@@ -5922,15 +5922,20 @@ package body Sem_Ch6 is
                then
                   Set_Has_Completion (E, False);
 
-                  if Expander_Active then
+                  if Expander_Active
+                    and then Nkind (Parent (E)) = N_Function_Specification
+                  then
                      Remove
                        (Unit_Declaration_Node
-                         (Corresponding_Body (Unit_Declaration_Node (E))));
+                          (Corresponding_Body (Unit_Declaration_Node (E))));
+
                      return E;
 
-                  --  If expansion is disabled, the wrapper function has not
-                  --  been generated, and this is the standard case of a late
-                  --  body overriding an inherited operation.
+                  --  If expansion is disabled, or if the wrapper function has
+                  --  not been generated yet, this a late body overriding an
+                  --  inherited operation, or it is an overriding by some other
+                  --  declaration before the controlling result is frozen. In
+                  --  either case this is a declaration of a new entity.
 
                   else
                      return Empty;