public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/autopar_devel] [Ada] Crash on dispatching conditional entry call
@ 2020-08-22 22:24 Giuliano Belinassi
0 siblings, 0 replies; only message in thread
From: Giuliano Belinassi @ 2020-08-22 22:24 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:a1a9b6619eca5f5999a55ade861c9140f91af3bc
commit a1a9b6619eca5f5999a55ade861c9140f91af3bc
Author: Javier Miranda <miranda@adacore.com>
Date: Wed Mar 4 14:22:44 2020 -0500
[Ada] Crash on dispatching conditional entry call
2020-06-11 Javier Miranda <miranda@adacore.com>
gcc/ada/
* exp_ch9.adb (Expand_N_Conditional_Entry_Call): Replace call to
New_Copy_List by calls to the new routine
New_Copy_Separate_List.
* sem_util.ads (New_Copy_Separate_List, New_Copy_Separate_Tree):
New routines.
* sem_util.adb (New_Copy_Separate_List, New_Copy_Separate_Tree):
New routines.
(New_Copy_Tree): Extend the machinery that detects syntactic
nodes to handle lists of indentifiers with field More_Ids;
otherwise such nodes are erroneously handled as semantic nodes.
Copy aspect specifications attached to nodes.
* sem_ch12.adb (Copy_Generic_Node): Protect reading attribute
Etype.
Diff:
---
gcc/ada/exp_ch9.adb | 4 +-
gcc/ada/sem_ch12.adb | 1 +
gcc/ada/sem_util.adb | 178 ++++++++++++++++++++++++++++++++++++++++++++++++++-
gcc/ada/sem_util.ads | 10 +++
4 files changed, 190 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 4c2af03efe2..49d3c1f324b 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -8124,7 +8124,7 @@ package body Exp_Ch9 is
-- <else-statements>
-- end if;
- N_Stats := New_Copy_List_Tree (Statements (Alt));
+ N_Stats := New_Copy_Separate_List (Statements (Alt));
Prepend_To (N_Stats,
Make_Implicit_If_Statement (N,
@@ -8168,7 +8168,7 @@ package body Exp_Ch9 is
-- <dispatching-call>;
-- <triggering-statements>
- Lim_Typ_Stmts := New_Copy_List_Tree (Statements (Alt));
+ Lim_Typ_Stmts := New_Copy_Separate_List (Statements (Alt));
Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (Blk));
-- Generate:
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 80a8246b3a6..93a3ca59d5c 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -8098,6 +8098,7 @@ package body Sem_Ch12 is
elsif Nkind (Assoc) = N_Identifier
and then Nkind (Parent (Assoc)) = N_Type_Conversion
and then Subtype_Mark (Parent (Assoc)) = Assoc
+ and then Present (Etype (Assoc))
and then Is_Access_Type (Etype (Assoc))
and then Present (Etype (Expression (Parent (Assoc))))
and then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 92dd39452d1..cce55a6c58a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -20323,6 +20323,118 @@ package body Sem_Util is
end if;
end New_Copy_List_Tree;
+ ----------------------------
+ -- New_Copy_Separate_List --
+ ----------------------------
+
+ function New_Copy_Separate_List (List : List_Id) return List_Id is
+ begin
+ if List = No_List then
+ return No_List;
+
+ else
+ declare
+ List_Copy : constant List_Id := New_List;
+ N : Node_Id := First (List);
+
+ begin
+ while Present (N) loop
+ Append (New_Copy_Separate_Tree (N), List_Copy);
+ Next (N);
+ end loop;
+
+ return List_Copy;
+ end;
+ end if;
+ end New_Copy_Separate_List;
+
+ ----------------------------
+ -- New_Copy_Separate_Tree --
+ ----------------------------
+
+ function New_Copy_Separate_Tree (Source : Node_Id) return Node_Id is
+ function Search_Decl (N : Node_Id) return Traverse_Result;
+ -- Subtree visitor which collects declarations
+
+ procedure Search_Declarations is new Traverse_Proc (Search_Decl);
+ -- Subtree visitor instantiation
+
+ -----------------
+ -- Search_Decl --
+ -----------------
+
+ Decls : Elist_Id;
+
+ function Search_Decl (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) in N_Declaration then
+ if No (Decls) then
+ Decls := New_Elmt_List;
+ end if;
+
+ Append_Elmt (N, Decls);
+ end if;
+
+ return OK;
+ end Search_Decl;
+
+ -- Local variables
+
+ Source_Copy : constant Node_Id := New_Copy_Tree (Source);
+
+ -- Start of processing for New_Copy_Separate_Tree
+
+ begin
+ Decls := No_Elist;
+ Search_Declarations (Source_Copy);
+
+ -- Associate a new Entity with all the subtree declarations (keeping
+ -- their original name).
+
+ if Present (Decls) then
+ declare
+ Elmt : Elmt_Id;
+ Decl : Node_Id;
+ New_E : Entity_Id;
+
+ begin
+ Elmt := First_Elmt (Decls);
+ while Present (Elmt) loop
+ Decl := Node (Elmt);
+ New_E := Make_Defining_Identifier (Sloc (Decl),
+ New_Internal_Name ('P'));
+
+ if Nkind (Decl) = N_Expression_Function then
+ Decl := Specification (Decl);
+ end if;
+
+ if Nkind_In (Decl, N_Function_Instantiation,
+ N_Function_Specification,
+ N_Generic_Function_Renaming_Declaration,
+ N_Generic_Package_Renaming_Declaration,
+ N_Generic_Procedure_Renaming_Declaration,
+ N_Package_Body,
+ N_Package_Instantiation,
+ N_Package_Renaming_Declaration,
+ N_Package_Specification,
+ N_Procedure_Instantiation,
+ N_Procedure_Specification)
+ then
+ Set_Chars (New_E, Chars (Defining_Unit_Name (Decl)));
+ Set_Defining_Unit_Name (Decl, New_E);
+ else
+ Set_Chars (New_E, Chars (Defining_Identifier (Decl)));
+ Set_Defining_Identifier (Decl, New_E);
+ end if;
+
+ Next_Elmt (Elmt);
+ end loop;
+ end;
+ end if;
+
+ return Source_Copy;
+ end New_Copy_Separate_Tree;
+
-------------------
-- New_Copy_Tree --
-------------------
@@ -20751,6 +20863,65 @@ 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_In (N, 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
@@ -20762,7 +20933,7 @@ package body Sem_Util is
elsif Field in Node_Range then
declare
Old_N : constant Node_Id := Node_Id (Field);
- Syntactic : constant Boolean := Parent (Old_N) = Old_Par;
+ Syntactic : constant Boolean := Is_Syntactic_Node;
New_N : Node_Id;
@@ -20990,6 +21161,11 @@ package body Sem_Util is
Set_Chars (Result, Chars (Entity (Result)));
end if;
end if;
+
+ if Has_Aspects (N) then
+ Set_Aspect_Specifications (Result,
+ Copy_List_With_Replacement (Aspect_Specifications (N)));
+ end if;
end if;
return Result;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e477c3849bb..b794e809822 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2291,6 +2291,16 @@ package Sem_Util is
-- below. As for New_Copy_Tree, it is illegal to attempt to copy extended
-- nodes (entities) either directly or indirectly using this function.
+ function New_Copy_Separate_List (List : List_Id) return List_Id;
+ -- Copy recursively a list of nodes using New_Copy_Separate_Tree
+
+ function New_Copy_Separate_Tree (Source : Node_Id) return Node_Id;
+ -- Perform a deep copy of the subtree rooted at Source using New_Copy_Tree
+ -- replacing entities of local declarations by new entities. This behavior
+ -- is required by the backend to ensure entities uniqueness when a copy of
+ -- a subtree is attached to the tree. The new entities keep their original
+ -- names to facilitate debugging the tree copy.
+
function New_Copy_Tree
(Source : Node_Id;
Map : Elist_Id := No_Elist;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-08-22 22:24 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-22 22:24 [gcc/devel/autopar_devel] [Ada] Crash on dispatching conditional entry call Giuliano Belinassi
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).