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.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f2e7ad76e98f8c81557bb5fcbfb0cf305757c3bc..8f1869cc70916569f2a509888db62ef9c4e94663 100644 (file)
--- 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 4e0052e9ee417ec716aee0f6adb63bfb6c7d7c0e..455cc226bbfb91c4e03a5dea5453d7231e85d757 100644 (file)
--- 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 06616eaf87d31feaf033d7a3e778d078abc61e61..3d8a542c24e0bdfcf8613e85de47b6fcd9e1234a 100644 (file)
--- 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 77d09d9ac069dc976fe2b285ca988bd55bcbf5c4..519d04b67b49e57e5a61e920dee4abe0b4b33dfa 100644 (file)
--- 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 6178767aab61336167eb0b9e5055d1b1bfed0584..1306f5ed56c74257c8b9390b32c2af48934fb739 100644 (file)
--- 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