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