* [COMMITTED] ada: Fix link to parent when copying with Copy_Separate_Tree
@ 2023-05-15 9:41 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-05-15 9:41 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/atree.adb | 62 +++++++++++++++++++++++++++++++++++++++++++-
gcc/ada/atree.ads | 8 ++++++
gcc/ada/sem_util.adb | 62 ++------------------------------------------
3 files changed, 71 insertions(+), 61 deletions(-)
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 6ad8b5d2fa3..669b1bf225d 100644
--- 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 eb1ff90c3ee..50f75cf4d59 100644
--- 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 f2856353671..5ec0140d090 100644
--- 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;
--
2.40.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-05-15 9:41 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-15 9:41 [COMMITTED] ada: Fix link to parent when copying with Copy_Separate_Tree Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).