atree.ads, atree.adb (Copy_Separate_List): New function that applies Copy_Separate_Tree to a list of nodes.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* atree.ads, atree.adb (Copy_Separate_List): New function that applies
	Copy_Separate_Tree to a list of nodes. Used to create disjoint copies
	of statement lists that may contain local declarations.
	(Expand_N_Timed_Entry_Call): Use Copy_Separate_List to duplicate the
	triggering statements needed for the expansion of this construct, when
	the trigger is a dispatching call to a synchronized primitive.

From-SVN: r178169

4 files changed, 55 insertions, 20 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a9551c7..4450cba 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* atree.ads, atree.adb (Copy_Separate_List): New function that applies
+	Copy_Separate_Tree to a list of nodes. Used to create disjoint copies
+	of statement lists that may contain local declarations.
+	(Expand_N_Timed_Entry_Call): Use Copy_Separate_List to duplicate the
+	triggering statements needed for the expansion of this construct, when
+	the trigger is a dispatching call to a synchronized primitive.
+
 2011-08-29  Arnaud Charlet  <charlet@adacore.com>
 
 	* gnat_rm.texi: Add doc for 'Elab_Subp_Body.
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 0df415d..17c6814 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -646,6 +646,24 @@ package body Atree is
    end Copy_Node;
 
    ------------------------
+   -- Copy_Separate_List --
+   ------------------------
+
+   function Copy_Separate_List (Source : List_Id) return List_Id is
+      Result : constant List_Id := New_List;
+      Nod    : Node_Id;
+
+   begin
+      Nod := First (Source);
+      while Present (Nod) loop
+         Append (Copy_Separate_Tree (Nod), Result);
+         Next (Nod);
+      end loop;
+
+      return Result;
+   end Copy_Separate_List;
+
+   ------------------------
    -- Copy_Separate_Tree --
    ------------------------
 
@@ -766,8 +784,8 @@ package body Atree is
          Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id)));
          Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id)));
 
-         --  Set Entity field to Empty
-         --  Why is this done??? and why is it always right to do it???
+         --  Set Entity field to Empty to ensure that no entity references
+         --  are shared between the two, if the source is already analyzed.
 
          if Nkind (New_Id) in N_Has_Entity
            or else Nkind (New_Id) = N_Freeze_Entity
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 6538a19c..e75a95f 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -429,16 +429,20 @@ package Atree is
    --  Source to be Empty, in which case Relocate_Node simply returns
    --  Empty as the result.
 
+   function Copy_Separate_List (Source : List_Id) return List_Id;
+   --  Apply the following to a list of nodes
+
    function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
    --  Given a node that is the root of a subtree, Copy_Separate_Tree copies
    --  the entire syntactic subtree, including recursively any descendants
    --  whose parent field references a copied node (descendants not linked to
    --  a copied node by the parent field are also copied.) The parent pointers
    --  in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns
-   --  Empty/Error. The semantic fields are not copied and the new subtree
-   --  does not share any entity with source subtree.
-   --  But the code *does* copy semantic fields, and the description above
-   --  is in any case unclear on this point ??? (RBKD)
+   --  Empty/Error. The new subtree does not share entities with the source,
+   --  but has new entities with the same name. Most of the time this routine
+   --  is called on an unanalyzed tree, and no semantic information is copied.
+   --  However, to ensure that no entities are shared between the two when the
+   --  source is already analyzed, entity fields in the copy are zeroed out.
 
    procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id);
    --  Exchange the contents of two entities. The parent pointers are switched
@@ -449,16 +453,15 @@ package Atree is
    --  two entities may be list members.
 
    function Extend_Node (Node : Node_Id) return Entity_Id;
-   --  This function returns a copy of its input node with an extension
-   --  added. The fields of the extension are set to Empty. Due to the way
-   --  extensions are handled (as four consecutive array elements), it may
-   --  be necessary to reallocate the node, so that the returned value is
-   --  not the same as the input value, but where possible the returned
-   --  value will be the same as the input value (i.e. the extension will
-   --  occur in place). It is the caller's responsibility to ensure that
-   --  any pointers to the original node are appropriately updated. This
-   --  function is used only by Sinfo.CN to change nodes into their
-   --  corresponding entities.
+   --  This function returns a copy of its input node with an extension added.
+   --  The fields of the extension are set to Empty. Due to the way extensions
+   --  are handled (as four consecutive array elements), it may be necessary
+   --  to reallocate the node, so that the returned value is not the same as
+   --  the input value, but where possible the returned value will be the same
+   --  as the input value (i.e. the extension will occur in place). It is the
+   --  caller's responsibility to ensure that any pointers to the original node
+   --  are appropriately updated. This function is used only by Sinfo.CN to
+   --  change nodes into their corresponding entities.
 
    type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
 
@@ -475,7 +478,7 @@ package Atree is
    --  the results of Process calls. See below for details.
 
    generic
-     with function Process (N : Node_Id) return Traverse_Result is <>;
+      with function Process (N : Node_Id) return Traverse_Result is <>;
    function Traverse_Func (Node : Node_Id) return Traverse_Final_Result;
    --  This is a generic function that, given the parent node for a subtree,
    --  traverses all syntactic nodes of this tree, calling the given function
@@ -501,7 +504,7 @@ package Atree is
    --  all calls to process returned either OK, OK_Orig, or Skip).
 
    generic
-     with function Process (N : Node_Id) return Traverse_Result is <>;
+      with function Process (N : Node_Id) return Traverse_Result is <>;
    procedure Traverse_Proc (Node : Node_Id);
    pragma Inline (Traverse_Proc);
    --  This is the same as Traverse_Func except that no result is returned,
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index a55a7f5..b0860bc 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -10990,6 +10990,11 @@ package body Exp_Ch9 is
    --          end if;
    --       end if;
    --    end;
+   --
+   --  The triggering statement and the timed statements have not been
+   --  analyzed yet (see Analyzed_Timed_Entry_Call).  They may contain local
+   --  declarations, and therefore the copies that are made during expansion
+   --  must be disjoint, as for any other inlining.
 
    procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
@@ -11284,7 +11289,7 @@ package body Exp_Ch9 is
          --       <timed-statements>
          --    end if;
 
-         N_Stats := New_Copy_List_Tree (E_Stats);
+         N_Stats := Copy_Separate_List (E_Stats);
 
          Prepend_To (N_Stats,
            Make_If_Statement (Loc,
@@ -11327,7 +11332,7 @@ package body Exp_Ch9 is
          --    <dispatching-call>;
          --    <triggering-statements>
 
-         Lim_Typ_Stmts := New_Copy_List_Tree (E_Stats);
+         Lim_Typ_Stmts := Copy_Separate_List (E_Stats);
          Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (E_Call));
 
          --  Generate: