aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2025-02-11 12:47:36 +0100
committerEric Botcazou <ebotcazou@adacore.com>2025-06-06 16:44:45 +0200
commit855fe3625493e3888df5da12aba945c243ec6650 (patch)
tree9e930641112a39633edc1bd51d5b0fa9fa64c344 /gcc
parent649bde867ae0a808b21e837744211339476c8099 (diff)
downloadgcc-855fe3625493e3888df5da12aba945c243ec6650.zip
gcc-855fe3625493e3888df5da12aba945c243ec6650.tar.gz
gcc-855fe3625493e3888df5da12aba945c243ec6650.tar.bz2
ada: Fix internal error on allocator involving interface type
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_aggr.adb3
-rw-r--r--gcc/ada/exp_attr.adb4
-rw-r--r--gcc/ada/exp_ch5.adb24
-rw-r--r--gcc/ada/exp_util.adb35
-rw-r--r--gcc/ada/exp_util.ads18
5 files changed, 51 insertions, 33 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f2e7ad7..8f1869c 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 4e0052e..455cc22 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 06616ea..3d8a542 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 b8c6a9f..51cc790 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 6178767..1306f5e 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