public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-1272] ada: Crash on loop in dispatching conditional entry call
@ 2023-05-26 7:36 Marc Poulhi?s
0 siblings, 0 replies; only message in thread
From: Marc Poulhi?s @ 2023-05-26 7:36 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:deba689502bb274e94f5a37a96d3fe582041e3b1
commit r14-1272-gdeba689502bb274e94f5a37a96d3fe582041e3b1
Author: Javier Miranda <miranda@adacore.com>
Date: Mon Mar 20 19:24:17 2023 +0000
ada: Crash on loop in dispatching conditional entry call
gcc/ada/
* exp_ch9.adb
(Expand_N_Conditional_Entry_Call): Factorize code to avoid
duplicating subtrees; required to avoid problems when the copied
code has implicit labels.
* sem_util.ads (New_Copy_Separate_List): Removed.
(New_Copy_Separate_Tree): Removed.
* sem_util.adb (New_Copy_Separate_List): Removed.
(New_Copy_Separate_Tree): Removed.
Diff:
---
gcc/ada/exp_ch9.adb | 38 ++++++++++++++----
gcc/ada/sem_util.adb | 107 ---------------------------------------------------
gcc/ada/sem_util.ads | 10 -----
3 files changed, 30 insertions(+), 125 deletions(-)
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index df4a083e96b..68f1290cab4 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -7712,7 +7712,7 @@ package body Exp_Ch9 is
-- or else K = Ada.Tags.TK_Tagged
-- then
-- <dispatching-call>;
- -- <triggering-statements>
+ -- -- <triggering-statements> (code factorized after if-stmt)
-- else
-- S :=
@@ -7737,11 +7737,14 @@ package body Exp_Ch9 is
-- <dispatching-call>;
-- end if;
- -- <triggering-statements>
+ -- -- <triggering-statements> (code factorized after if-stmt)
-- else
-- <else-statements>
+ -- goto L0; -- skip triggering statements
-- end if;
-- end if;
+ -- <triggering-statements>
+ -- L0:
-- end;
procedure Expand_N_Conditional_Entry_Call (N : Node_Id) is
@@ -7757,6 +7760,8 @@ package body Exp_Ch9 is
Decl : Node_Id;
Decls : List_Id;
Formals : List_Id;
+ Label : Node_Id;
+ Label_Id : Entity_Id := Empty;
Lim_Typ_Stmts : List_Id;
N_Stats : List_Id;
Obj : Entity_Id;
@@ -7883,12 +7888,13 @@ package body Exp_Ch9 is
-- then
-- <dispatching-call>
-- end if;
- -- <normal-statements>
+ -- -- <triggering-stataments> (code factorized after if-stmt)
-- else
-- <else-statements>
+ -- goto L0; -- skip triggering statements
-- end if;
- N_Stats := New_Copy_Separate_List (Statements (Alt));
+ N_Stats := New_List;
Prepend_To (N_Stats,
Make_Implicit_If_Statement (N,
@@ -7922,6 +7928,14 @@ package body Exp_Ch9 is
Then_Statements =>
New_List (Blk)));
+ Label_Id := Make_Identifier (Loc, New_External_Name ('L', 0));
+ Set_Entity (Label_Id,
+ Make_Defining_Identifier (Loc, Chars (Label_Id)));
+
+ Append_To (Else_Statements (N),
+ Make_Goto_Statement (Loc,
+ Name => New_Occurrence_Of (Entity (Label_Id), Loc)));
+
Append_To (Conc_Typ_Stmts,
Make_Implicit_If_Statement (N,
Condition => New_Occurrence_Of (B, Loc),
@@ -7930,15 +7944,14 @@ package body Exp_Ch9 is
-- Generate:
-- <dispatching-call>;
- -- <triggering-statements>
+ -- -- <triggering-statements> (code factorized after if-stmt)
- Lim_Typ_Stmts := New_Copy_Separate_List (Statements (Alt));
- Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (Blk));
+ Lim_Typ_Stmts := New_List (New_Copy_Tree (Blk));
-- Generate:
-- if K = Ada.Tags.TK_Limited_Tagged
-- or else K = Ada.Tags.TK_Tagged
- -- then
+ -- then
-- Lim_Typ_Stmts
-- else
-- Conc_Typ_Stmts
@@ -7950,6 +7963,15 @@ package body Exp_Ch9 is
Then_Statements => Lim_Typ_Stmts,
Else_Statements => Conc_Typ_Stmts));
+ Label := Make_Label (Loc, Label_Id);
+ Append_To (Decls,
+ Make_Implicit_Label_Declaration (Loc,
+ Defining_Identifier => Entity (Label_Id),
+ Label_Construct => Label));
+
+ Append_List_To (Stmts, Statements (Alt)); -- triggering-statements
+ Append_To (Stmts, Label);
+
Rewrite (N,
Make_Block_Statement (Loc,
Declarations =>
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d15e20b81a7..64c12cc7ecf 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -22886,113 +22886,6 @@ 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
- Append_New_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_Temporary (Sloc (Decl), 'P');
-
- if Nkind (Decl) = N_Expression_Function then
- Decl := Specification (Decl);
- end if;
-
- if Nkind (Decl) in 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 --
-------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 6f5b20e5cf2..b5bcd267e33 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2623,16 +2623,6 @@ 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:[~2023-05-26 7:36 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-26 7:36 [gcc r14-1272] ada: Crash on loop in dispatching conditional entry call 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).