aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2022-12-22 23:36:47 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-05-15 11:36:40 +0200
commitf04dae641112509bfd4ec8bd76774ebedca28d1f (patch)
treed70658ca852e08542c5c881a169815fe1f5ae42a /gcc/ada
parente90791e5a02b021d22ffb4c36673b9af623e2063 (diff)
downloadgcc-f04dae641112509bfd4ec8bd76774ebedca28d1f.zip
gcc-f04dae641112509bfd4ec8bd76774ebedca28d1f.tar.gz
gcc-f04dae641112509bfd4ec8bd76774ebedca28d1f.tar.bz2
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.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/atree.adb62
-rw-r--r--gcc/ada/atree.ads8
-rw-r--r--gcc/ada/sem_util.adb62
3 files changed, 71 insertions, 61 deletions
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 6ad8b5d..669b1bf 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 eb1ff90..50f75cf 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 f285635..5ec0140 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;