===================================================================
@@ -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;
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.