From: Eric Botcazou <ebotca...@adacore.com>
The problem is that an itype duplicated through Duplicate_Subexpr_No_Checks
ends up in a different scope than its source. It is fixed by adding a new
formal parameter New_Scope to the function and forwarding it in the call to
the New_Copy_Tree function.
gcc/ada/ChangeLog:
* exp_aggr.adb (Expand_Record_Aggregate): Use the named form for the
second actual parameter in the call to Duplicate_Subexpr.
* exp_attr.adb (Expand_Size_Attribute): Likewise.
* exp_ch5.adb (Expand_Assign_Array): Likewise.
(Expand_Assign_Array_Bitfield): Likewise.
(Expand_Assign_Array_Bitfield_Fast): Likewise.
* exp_util.ads (Duplicate_Subexpr): Add New_Scope formal parameter.
(Duplicate_Subexpr_No_Checks): Likewise.
(Duplicate_Subexpr_Move_Checks): Likewise.
* exp_util.adb (Build_Allocate_Deallocate_Proc): Pass Proc_Id as the
actual for New_Scope in the calls to Duplicate_Subexpr_No_Checks.
(Duplicate_Subexpr): Add New_Scope formal parameter and forward it
in the call to New_Copy_Tree.
(Duplicate_Subexpr_No_Checks): Likewise.
(Duplicate_Subexpr_Move_Checks): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 3 ++-
gcc/ada/exp_attr.adb | 4 ++--
gcc/ada/exp_ch5.adb | 24 +++++++++++++-----------
gcc/ada/exp_util.adb | 35 ++++++++++++++++++++++-------------
gcc/ada/exp_util.ads | 18 ++++++++++++------
5 files changed, 51 insertions(+), 33 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f2e7ad76e98..8f1869cc709 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -8077,7 +8077,8 @@ package body Exp_Aggr is
Make_Selected_Component (Loc,
Prefix =>
Unchecked_Convert_To (Typ,
- Duplicate_Subexpr (Parent_Expr, True)),
+ Duplicate_Subexpr
+ (Parent_Expr, Name_Req => True)),
Selector_Name => New_Occurrence_Of (Comp, Loc));
Append_To (Comps,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 4e0052e9ee4..455cc226bbf 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -8602,10 +8602,10 @@ package body Exp_Attr is
Rewrite (N,
Make_Op_Multiply (Loc,
Make_Attribute_Reference (Loc,
- Prefix => Duplicate_Subexpr (Pref, True),
+ Prefix => Duplicate_Subexpr (Pref, Name_Req => True),
Attribute_Name => Name_Length),
Make_Attribute_Reference (Loc,
- Prefix => Duplicate_Subexpr (Pref, True),
+ Prefix => Duplicate_Subexpr (Pref, Name_Req => True),
Attribute_Name => Name_Component_Size)));
Analyze_And_Resolve (N, Typ);
end if;
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 06616eaf87d..3d8a542c24e 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -1039,7 +1039,8 @@ package body Exp_Ch5 is
Prefix =>
Make_Indexed_Component (Loc,
Prefix =>
- Duplicate_Subexpr_Move_Checks (Larray, True),
+ Duplicate_Subexpr_Move_Checks
+ (Larray, Name_Req => True),
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
@@ -1054,7 +1055,8 @@ package body Exp_Ch5 is
Prefix =>
Make_Indexed_Component (Loc,
Prefix =>
- Duplicate_Subexpr_Move_Checks (Rarray, True),
+ Duplicate_Subexpr_Move_Checks
+ (Rarray, Name_Req => True),
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
@@ -1396,7 +1398,7 @@ package body Exp_Ch5 is
Prefix =>
Make_Indexed_Component (Loc,
Prefix =>
- Duplicate_Subexpr (Larray, True),
+ Duplicate_Subexpr (Larray, Name_Req => True),
Expressions => New_List (New_Copy_Tree (Left_Lo))),
Attribute_Name => Name_Address);
@@ -1405,7 +1407,7 @@ package body Exp_Ch5 is
Prefix =>
Make_Indexed_Component (Loc,
Prefix =>
- Duplicate_Subexpr (Larray, True),
+ Duplicate_Subexpr (Larray, Name_Req => True),
Expressions => New_List (New_Copy_Tree (Left_Lo))),
Attribute_Name => Name_Bit);
@@ -1414,7 +1416,7 @@ package body Exp_Ch5 is
Prefix =>
Make_Indexed_Component (Loc,
Prefix =>
- Duplicate_Subexpr (Rarray, True),
+ Duplicate_Subexpr (Rarray, Name_Req => True),
Expressions => New_List (New_Copy_Tree (Right_Lo))),
Attribute_Name => Name_Address);
@@ -1423,7 +1425,7 @@ package body Exp_Ch5 is
Prefix =>
Make_Indexed_Component (Loc,
Prefix =>
- Duplicate_Subexpr (Rarray, True),
+ Duplicate_Subexpr (Rarray, Name_Req => True),
Expressions => New_List (New_Copy_Tree (Right_Lo))),
Attribute_Name => Name_Bit);
@@ -1439,11 +1441,11 @@ package body Exp_Ch5 is
Make_Op_Multiply (Loc,
Make_Attribute_Reference (Loc,
Prefix =>
- Duplicate_Subexpr (Name (N), True),
+ Duplicate_Subexpr (Name (N), Name_Req => True),
Attribute_Name => Name_Length),
Make_Attribute_Reference (Loc,
Prefix =>
- Duplicate_Subexpr (Name (N), True),
+ Duplicate_Subexpr (Name (N), Name_Req => True),
Attribute_Name => Name_Component_Size));
begin
@@ -1527,11 +1529,11 @@ package body Exp_Ch5 is
Make_Op_Multiply (Loc,
Make_Attribute_Reference (Loc,
Prefix =>
- Duplicate_Subexpr (Name (N), True),
+ Duplicate_Subexpr (Name (N), Name_Req => True),
Attribute_Name => Name_Length),
Make_Attribute_Reference (Loc,
Prefix =>
- Duplicate_Subexpr (Larray, True),
+ Duplicate_Subexpr (Larray, Name_Req => True),
Attribute_Name => Name_Component_Size));
L_Arg, R_Arg, Call : Node_Id;
@@ -1582,7 +1584,7 @@ package body Exp_Ch5 is
end if;
return Make_Assignment_Statement (Loc,
- Name => Duplicate_Subexpr (Larray, True),
+ Name => Duplicate_Subexpr (Larray, Name_Req => True),
Expression => Unchecked_Convert_To (L_Typ, Call));
end Expand_Assign_Array_Bitfield_Fast;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 77d09d9ac06..519d04b67b4 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1081,10 +1081,12 @@ package body Exp_Util is
Make_Attribute_Reference (Loc,
Prefix =>
(if Is_Allocate then
- Duplicate_Subexpr_No_Checks (Expression (Alloc_Expr))
+ Duplicate_Subexpr_No_Checks
+ (Expression (Alloc_Expr), New_Scope => Proc_Id)
else
Make_Explicit_Dereference (Loc,
- Duplicate_Subexpr_No_Checks (Expr))),
+ Duplicate_Subexpr_No_Checks
+ (Expr, New_Scope => Proc_Id))),
Attribute_Name => Name_Alignment)));
end if;
@@ -1137,7 +1139,9 @@ package body Exp_Util is
if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
Param :=
Make_Explicit_Dereference (Loc,
- Prefix => Duplicate_Subexpr_No_Checks (Temp));
+ Prefix =>
+ Duplicate_Subexpr_No_Checks
+ (Temp, New_Scope => Proc_Id));
-- In the default case, obtain the tag of the object about
-- to be allocated / deallocated. Generate:
@@ -1157,7 +1161,9 @@ package body Exp_Util is
Param :=
Make_Attribute_Reference (Loc,
- Prefix => Duplicate_Subexpr_No_Checks (Temp),
+ Prefix =>
+ Duplicate_Subexpr_No_Checks
+ (Temp, New_Scope => Proc_Id),
Attribute_Name => Name_Tag);
end if;
@@ -5062,12 +5068,13 @@ package body Exp_Util is
function Duplicate_Subexpr
(Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id
+ New_Scope : Entity_Id := Empty;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False) return Node_Id
is
begin
Remove_Side_Effects (Exp, Name_Req, Renaming_Req);
- return New_Copy_Tree (Exp);
+ return New_Copy_Tree (Exp, New_Scope => New_Scope);
end Duplicate_Subexpr;
---------------------------------
@@ -5076,8 +5083,9 @@ package body Exp_Util is
function Duplicate_Subexpr_No_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id
+ New_Scope : Entity_Id := Empty;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False) return Node_Id
is
New_Exp : Node_Id;
@@ -5087,7 +5095,7 @@ package body Exp_Util is
Name_Req => Name_Req,
Renaming_Req => Renaming_Req);
- New_Exp := New_Copy_Tree (Exp);
+ New_Exp := New_Copy_Tree (Exp, New_Scope => New_Scope);
Remove_Checks (New_Exp);
return New_Exp;
end Duplicate_Subexpr_No_Checks;
@@ -5098,14 +5106,15 @@ package body Exp_Util is
function Duplicate_Subexpr_Move_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id
+ New_Scope : Entity_Id := Empty;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False) return Node_Id
is
New_Exp : Node_Id;
begin
Remove_Side_Effects (Exp, Name_Req, Renaming_Req);
- New_Exp := New_Copy_Tree (Exp);
+ New_Exp := New_Copy_Tree (Exp, New_Scope => New_Scope);
Remove_Checks (Exp);
return New_Exp;
end Duplicate_Subexpr_Move_Checks;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 6178767aab6..1306f5ed56c 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -479,8 +479,9 @@ package Exp_Util is
function Duplicate_Subexpr
(Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id;
+ New_Scope : Entity_Id := Empty;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False) return Node_Id;
-- Given the node for a subexpression, this function makes a logical copy
-- of the subexpression, and returns it. This is intended for use when the
-- expansion of an expression needs to repeat part of it. For example,
@@ -494,6 +495,9 @@ package Exp_Util is
-- the caller is responsible for analyzing the returned copy after it is
-- attached to the tree.
--
+ -- The New_Scope entity may be used to specify a new scope for all copied
+ -- entities and itypes.
+ --
-- The Name_Req flag is set to ensure that the result is suitable for use
-- in a context requiring a name (for example, the prefix of an attribute
-- reference).
@@ -509,8 +513,9 @@ package Exp_Util is
function Duplicate_Subexpr_No_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id;
+ New_Scope : Entity_Id := Empty;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False) return Node_Id;
-- Identical in effect to Duplicate_Subexpr, except that Remove_Checks is
-- called on the result, so that the duplicated expression does not include
-- checks. This is appropriate for use when Exp, the original expression is
@@ -519,8 +524,9 @@ package Exp_Util is
function Duplicate_Subexpr_Move_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id;
+ New_Scope : Entity_Id := Empty;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False) return Node_Id;
-- Identical in effect to Duplicate_Subexpr, except that Remove_Checks is
-- called on Exp after the duplication is complete, so that the original
-- expression does not include checks. In this case the result returned
--
2.43.0
