From: Eric Botcazou <ebotca...@adacore.com>
The problem is that we analyze references to an object before the actual
subtype of the object is established, thus creating a type mismatch that
is flagged by the code generator.
gcc/ada/ChangeLog:
* exp_ch7.ads (Store_After_Actions_In_Scope_Without_Analysis): New
procedure declaration.
* exp_ch7.adb (Store_New_Actions_In_Scope): New procedure.
(Store_Actions_In_Scope): Call Store_New_Actions_In_Scope when the
target list is empty.
(Store_After_Actions_In_Scope_Without_Analysis): New procedure body.
* exp_aggr.adb (Expand_Container_Aggregate): For a declaration that
is wrapped in a transient scope, also defer the analysis of the new
code until after the declaration is analyzed.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 9 +++----
gcc/ada/exp_ch7.adb | 56 +++++++++++++++++++++++++++++++++++++-------
gcc/ada/exp_ch7.ads | 7 ++++--
3 files changed, 57 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a51e02bc308..428115f81ba 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7345,12 +7345,13 @@ package body Exp_Aggr is
-- If a transient scope has been created around the declaration, we
-- need to attach the code to it so that the finalization actions of
- -- the declaration will be inserted after it. Otherwise, we directly
- -- insert it after the declaration and it will be analyzed only once
- -- the declaration is processed.
+ -- the declaration will be inserted after it; otherwise, we directly
+ -- insert it after the declaration. In both cases, the code will be
+ -- analyzed after the declaration is processed, i.e. once the actual
+ -- subtype of the object is established.
if Scope_Is_Transient and then Par = Node_To_Be_Wrapped then
- Insert_Actions_After (Par, Aggr_Code);
+ Store_After_Actions_In_Scope_Without_Analysis (Aggr_Code);
else
Insert_List_After (Par, Aggr_Code);
end if;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 171ad4ef395..a841d3af60f 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -514,7 +514,13 @@ package body Exp_Ch7 is
-- cleanup actions are performed at the end of the block.
procedure Store_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id);
- -- Shared processing for Store_xxx_Actions_In_Scope
+ -- Shared processing for the Store_xxx_Actions_In_Scope routines: attach
+ -- the list L of actions to the list of actions stored in the top of the
+ -- scope stack specified by AK.
+
+ procedure Store_New_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id);
+ -- Same as above for the case where the list of actions stored in the top
+ -- of the scope stack specified by AK is empty.
-------------------------------------------
-- Unnesting procedures for CCG and LLVM --
@@ -8907,14 +8913,7 @@ package body Exp_Ch7 is
begin
if Is_Empty_List (Actions) then
- Actions := L;
-
- if Is_List_Member (SE.Node_To_Be_Wrapped) then
- Set_Parent (L, Parent (SE.Node_To_Be_Wrapped));
- else
- Set_Parent (L, SE.Node_To_Be_Wrapped);
- end if;
-
+ Store_New_Actions_In_Scope (AK, L);
Analyze_List (L);
elsif AK = Before then
@@ -8934,6 +8933,22 @@ package body Exp_Ch7 is
Store_Actions_In_Scope (After, L);
end Store_After_Actions_In_Scope;
+ ---------------------------------------------------
+ -- Store_After_Actions_In_Scope_Without_Analysis --
+ ---------------------------------------------------
+
+ procedure Store_After_Actions_In_Scope_Without_Analysis (L : List_Id) is
+ SE : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
+ Actions : List_Id renames SE.Actions_To_Be_Wrapped (After);
+
+ begin
+ if Is_Empty_List (Actions) then
+ Store_New_Actions_In_Scope (After, L);
+ else
+ Insert_List_Before (First (Actions), L);
+ end if;
+ end Store_After_Actions_In_Scope_Without_Analysis;
+
-----------------------------------
-- Store_Before_Actions_In_Scope --
-----------------------------------
@@ -8952,6 +8967,29 @@ package body Exp_Ch7 is
Store_Actions_In_Scope (Cleanup, L);
end Store_Cleanup_Actions_In_Scope;
+ --------------------------------
+ -- Store_New_Actions_In_Scope --
+ --------------------------------
+
+ procedure Store_New_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id)
+ is
+ SE : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
+ Actions : List_Id renames SE.Actions_To_Be_Wrapped (AK);
+
+ begin
+ pragma Assert (Is_Empty_List (Actions));
+
+ Actions := L;
+
+ -- Set the Parent link to provide the context for the actions
+
+ if Is_List_Member (SE.Node_To_Be_Wrapped) then
+ Set_Parent (L, Parent (SE.Node_To_Be_Wrapped));
+ else
+ Set_Parent (L, SE.Node_To_Be_Wrapped);
+ end if;
+ end Store_New_Actions_In_Scope;
+
------------------
-- Unnest_Block --
------------------
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index 22303d4c22f..d013eff9a45 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -311,7 +311,7 @@ package Exp_Ch7 is
-- Return the node to be wrapped if the current scope is transient
procedure Store_Before_Actions_In_Scope (L : List_Id);
- -- Append the list L of actions to the end of the before-actions store in
+ -- Append the list L of actions to the end of the before-actions stored in
-- the top of the scope stack (also analyzes these actions).
procedure Store_After_Actions_In_Scope (L : List_Id);
@@ -324,9 +324,12 @@ package Exp_Ch7 is
-- last call executed first). Within the list L for a single call, the
-- actions are executed in the order in which they appear in this list.
+ procedure Store_After_Actions_In_Scope_Without_Analysis (L : List_Id);
+ -- Same as above, but without analyzing the actions
+
procedure Store_Cleanup_Actions_In_Scope (L : List_Id);
-- Prepend the list L of actions to the beginning of the cleanup-actions
- -- store in the top of the scope stack.
+ -- stored in the top of the scope stack.
procedure Wrap_Transient_Declaration (N : Node_Id);
-- N is an object declaration. Expand the finalization calls after the
--
2.43.0
