[Ada] Classwide controlled obj not dispatching

Message ID 20200610133540.GA80661@adacore.com
State New
Headers show
Series
  • [Ada] Classwide controlled obj not dispatching
Related show

Commit Message

Pierre-Marie de Rodat June 10, 2020, 1:35 p.m.
Overriding dispatching primitives Initialize, Adjust or Finalize of a
controlled type by means of a subprogram body that has no specification
causes the frontend to initialize incorrectly the dispatch table slots
of these primitives.

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

2020-06-10  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sem_ch3.adb (Analyze_Declarations): Adjust the machinery that
	takes care of late body overriding of initialize, adjust,
	finalize.  Remove ASIS mode code.

Patch

--- gcc/ada/sem_ch3.adb
+++ gcc/ada/sem_ch3.adb
@@ -2592,12 +2592,10 @@  package body Sem_Ch3 is
       --  Local variables
 
       Context     : Node_Id   := Empty;
+      Ctrl_Typ    : Entity_Id := Empty;
       Freeze_From : Entity_Id := Empty;
       Next_Decl   : Node_Id;
 
-      Body_Seen : Boolean := False;
-      --  Flag set when the first body [stub] is encountered
-
    --  Start of processing for Analyze_Declarations
 
    begin
@@ -2613,6 +2611,16 @@  package body Sem_Ch3 is
             Freeze_From := First_Entity (Current_Scope);
          end if;
 
+         --  Remember if the declaration we just processed is the full type
+         --  declaration of a controlled type (to handle late overriding of
+         --  initialize, adjust or finalize).
+
+         if Nkind (Decl) = N_Full_Type_Declaration
+           and then Is_Controlled (Defining_Identifier (Decl))
+         then
+            Ctrl_Typ := Defining_Identifier (Decl);
+         end if;
+
          --  At the end of a declarative part, freeze remaining entities
          --  declared in it. The end of the visible declarations of package
          --  specification is not the end of a declarative part if private
@@ -2758,19 +2766,17 @@  package body Sem_Ch3 is
             --  ??? A cleaner approach may be possible and/or this solution
             --  could be extended to general-purpose late primitives, TBD.
 
-            if not Body_Seen and then not Is_Body (Decl) then
-               Body_Seen := True;
+            if Present (Ctrl_Typ) then
 
-               if Nkind (Next_Decl) = N_Subprogram_Body then
-                  Handle_Late_Controlled_Primitive (Next_Decl);
-               end if;
+               --  No need to continue searching for late body overriding if
+               --  the controlled type is already frozen.
 
-            else
-               --  In ASIS mode, if the next declaration is a body, complete
-               --  the analysis of declarations so far.
-               --  Is this still needed???
+               if Is_Frozen (Ctrl_Typ) then
+                  Ctrl_Typ := Empty;
 
-               Resolve_Aspects;
+               elsif Nkind (Next_Decl) = N_Subprogram_Body then
+                  Handle_Late_Controlled_Primitive (Next_Decl);
+               end if;
             end if;
 
             Adjust_Decl;