ada: Fix link to parent when copying with Copy_Separate_Tree

When flag More_Ids is set on a node, then syntactic children will have
their Parent link set to the last node in the chain of Mode_Ids.

For example, parameter associations in declaration like:

   procedure P (X, Y : T);

will have More_Ids set for "X", Prev_Ids set on "Y" and both will have
the same node of "T" as their child. However, "T" will have only one
parent, i.e. "Y".

This anomaly was taken into account in New_Copy_Tree, but not in
Copy_Separate_Tree. This was leading to spurious errors in check for
ghost-correctness applied to copied specs.

gcc/ada/

	* atree.ads
	(Is_Syntactic_Node): Refactored from New_Copy_Tree.
	* atree.adb
	(Is_Syntactic_Node): Likewise.
	(Copy_Separate_Tree): Use Is_Syntactic_Node.
	* sem_util.adb
	(Has_More_Ids): Move to Atree.
	(Is_Syntactic_Node): Likewise.

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 6ad8b5d2fa3358178a572ad3c47dfd0275ff7dfc..669b1bf225dc641966878113423816c5d401e32b 100644 (file)
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -1378,7 +1378,7 @@ package body Atree is
             New_N := Union_Id (Copy_Separate_Tree (Node_Id (Field)));
 
             if Present (Node_Id (Field))
-              and then Parent (Node_Id (Field)) = Source
+              and then Is_Syntactic_Node (Source, Node_Id (Field))
             then
                Set_Parent (Node_Id (New_N), New_Id);
             end if;
@@ -1619,6 +1619,66 @@ package body Atree is
       return Nkind (N) in N_Entity;
    end Is_Entity;
 
+   -----------------------
+   -- Is_Syntactic_Node --
+   -----------------------
+
+   function Is_Syntactic_Node
+     (Source : Node_Id;
+      Field  : Node_Id)
+      return Boolean
+   is
+      function Has_More_Ids (N : Node_Id) return Boolean;
+      --  Return True when N has attribute More_Ids set to True
+
+      ------------------
+      -- Has_More_Ids --
+      ------------------
+
+      function Has_More_Ids (N : Node_Id) return Boolean is
+      begin
+         if Nkind (N) in N_Component_Declaration
+                       | N_Discriminant_Specification
+                       | N_Exception_Declaration
+                       | N_Formal_Object_Declaration
+                       | N_Number_Declaration
+                       | N_Object_Declaration
+                       | N_Parameter_Specification
+                       | N_Use_Package_Clause
+                       | N_Use_Type_Clause
+         then
+            return More_Ids (N);
+         else
+            return False;
+         end if;
+      end Has_More_Ids;
+
+   --  Start of processing for Is_Syntactic_Node
+
+   begin
+      if Parent (Field) = Source then
+         return True;
+
+      --  Perform the check using the last id in the syntactic chain
+
+      elsif Has_More_Ids (Source) then
+         declare
+            N : Node_Id := Source;
+
+         begin
+            while Present (N) and then More_Ids (N) loop
+               Next (N);
+            end loop;
+
+            pragma Assert (Prev_Ids (N));
+            return Parent (Field) = N;
+         end;
+
+      else
+         return False;
+      end if;
+   end Is_Syntactic_Node;
+
    ----------------
    -- Initialize --
    ----------------

diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index eb1ff90c3eedfef7ce6fc739992351f73dca42e3..50f75cf4d594c4b05514fcc5ccf09bcc6de58f3c 100644 (file)
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -225,6 +225,14 @@ package Atree is
    pragma Inline (Is_Entity);
    --  Returns True if N is an entity
 
+   function Is_Syntactic_Node
+     (Source : Node_Id;
+      Field  : Node_Id)
+      return Boolean;
+   --  Return True when Field is a syntactic child of node Source. It is called
+   --  when creating a copy of Source to preserve the Parent link in the copy
+   --  of Field.
+
    function New_Node
      (New_Node_Kind : Node_Kind;
       New_Sloc      : Source_Ptr) return Node_Id;

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f2856353671508cfe1d37fd76be10d04d916802f..5ec0140d090364452147f837fd939f77bf3e8e14 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23323,65 +23323,6 @@ package body Sem_Util is
          New_Par  : Node_Id := Empty;
          Semantic : Boolean := False) return Union_Id
       is
-         function Has_More_Ids (N : Node_Id) return Boolean;
-         --  Return True when N has attribute More_Ids set to True
-
-         function Is_Syntactic_Node return Boolean;
-         --  Return True when Field is a syntactic node
-
-         ------------------
-         -- Has_More_Ids --
-         ------------------
-
-         function Has_More_Ids (N : Node_Id) return Boolean is
-         begin
-            if Nkind (N) in N_Component_Declaration
-                          | N_Discriminant_Specification
-                          | N_Exception_Declaration
-                          | N_Formal_Object_Declaration
-                          | N_Number_Declaration
-                          | N_Object_Declaration
-                          | N_Parameter_Specification
-                          | N_Use_Package_Clause
-                          | N_Use_Type_Clause
-            then
-               return More_Ids (N);
-            else
-               return False;
-            end if;
-         end Has_More_Ids;
-
-         -----------------------
-         -- Is_Syntactic_Node --
-         -----------------------
-
-         function Is_Syntactic_Node return Boolean is
-            Old_N : constant Node_Id := Node_Id (Field);
-
-         begin
-            if Parent (Old_N) = Old_Par then
-               return True;
-
-            elsif not Has_More_Ids (Old_Par) then
-               return False;
-
-            --  Perform the check using the last last id in the syntactic chain
-
-            else
-               declare
-                  N : Node_Id := Old_Par;
-
-               begin
-                  while Present (N) and then More_Ids (N) loop
-                     Next (N);
-                  end loop;
-
-                  pragma Assert (Prev_Ids (N));
-                  return Parent (Old_N) = N;
-               end;
-            end if;
-         end Is_Syntactic_Node;
-
       begin
          --  The field is empty
 
@@ -23393,7 +23334,8 @@ package body Sem_Util is
          elsif Field in Node_Range then
             declare
                Old_N     : constant Node_Id := Node_Id (Field);
-               Syntactic : constant Boolean := Is_Syntactic_Node;
+               Syntactic : constant Boolean :=
+                 Is_Syntactic_Node (Source => Old_Par, Field => Old_N);
 
                New_N : Node_Id;