[Ada] Abstrct null extensions

Message ID 20101008101327.GA30599@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 8, 2010, 10:13 a.m.
AI05-0097 fixes a gap in the RM, that allowed an abstract null extension to
inherit a concrete constructor.
The following must be rejected in any Ada mode:

package P is
    type Generator is tagged record
       Value : Integer := 17;
    end record;

    function Create return Generator;
 end P;
 with P;
 package Q is
     type Windmill is abstract new P.Generator with null record;
     -- Inherits a concrete Create here(!!)
 end Q;
 with P, Q;
 procedure Main is
     Obj : P.Generator'Class := Q.Create;

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

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

	* sem_ch3.adb (Derive_Subprogram): If an abstract extension has a
	concrete parent with a concrete constructor, the inherited constructor
	is abstract even if the derived type is a null extension.


Index: sem_ch3.adb
--- sem_ch3.adb	(revision 165154)
+++ sem_ch3.adb	(working copy)
@@ -12601,6 +12601,9 @@  package body Sem_Ch3 is
       if Ekind (Parent_Subp) = E_Procedure then
            (New_Subp, Is_Valued_Procedure (Parent_Subp));
+      else
+         Set_Has_Controlling_Result
+           (New_Subp, Has_Controlling_Result (Parent_Subp));
       end if;
       --  No_Return must be inherited properly. If this is overridden in the
@@ -12654,6 +12657,15 @@  package body Sem_Ch3 is
          Set_Is_Abstract_Subprogram (New_Subp);
+      --  AI05-0097 : an inherited operation that dispatches on result is
+      --  abstract if the derived type is abstract, even if the parent type
+      --  is concrete and the derived type is a null extension.
+      elsif Has_Controlling_Result (Alias (New_Subp))
+        and then Is_Abstract_Type (Etype (New_Subp))
+      then
+         Set_Is_Abstract_Subprogram (New_Subp);
       --  Finally, if the parent type is abstract we must verify that all
       --  inherited operations are either non-abstract or overridden, or that
       --  the derived type itself is abstract (this check is performed at the