From 9aa357c75358a51f038e50f7c8d9207b58c157e0 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 12 Oct 2019 14:47:34 +0000 Subject: [PATCH] re PR ada/91995 (gnat miscompilation and bootstrap failure on m68k-linux) PR ada/91995 * sem_ch8.adb (Chain_Use_Clause): Remove second argument in calls to Defining_Entity. * sem_elab.adb (Find_Unit_Entity): Likewise. Deal with N_Subunit here in lieu of in Defining_Entity. * sem_util.ads (Defining_Entity): Remove 2nd and 3th parameters. * sem_util.adb (Defining_Entity): Remove 2nd and 3th parameters, and adjust accordingly. Deal with N_Compilation_Unit. From-SVN: r276916 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/sem_ch8.adb | 6 ++---- gcc/ada/sem_elab.adb | 16 +++++++++++++--- gcc/ada/sem_util.adb | 43 +++++++++---------------------------------- gcc/ada/sem_util.ads | 21 +-------------------- 5 files changed, 36 insertions(+), 61 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index adbfa7027ce..e66f11133ea 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-10-12 Eric Botcazou + + PR ada/91995 + * sem_ch8.adb (Chain_Use_Clause): Remove second argument in calls + to Defining_Entity. + * sem_elab.adb (Find_Unit_Entity): Likewise. Deal with N_Subunit + here in lieu of in Defining_Entity. + * sem_util.ads (Defining_Entity): Remove 2nd and 3th parameters. + * sem_util.adb (Defining_Entity): Remove 2nd and 3th parameters, + and adjust accordingly. Deal with N_Compilation_Unit. + 2019-10-11 Eric Botcazou * gcc-interface/decl.c (elaborate_reference_1): Specifically deal with diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 5d03f835c8b..38cbf1cd26b 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4290,16 +4290,14 @@ package body Sem_Ch8 is -- Common case for compilation unit - elsif Defining_Entity (N => Parent (N), - Empty_On_Errors => True) = Current_Scope - then + elsif Defining_Entity (Parent (N)) = Current_Scope then null; else -- If declaration appears in some other scope, it must be in some -- parent unit when compiling a child. - Pack := Defining_Entity (Parent (N), Empty_On_Errors => True); + Pack := Defining_Entity (Parent (N)); if not In_Open_Scopes (Pack) then null; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 2dbf54da555..0c71f5910d5 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -9103,13 +9103,23 @@ package body Sem_Elab is N_Procedure_Instantiation) and then Nkind (Context) = N_Compilation_Unit then - return - Related_Instance (Defining_Entity (N, Concurrent_Subunit => True)); + return Related_Instance (Defining_Entity (N)); + + -- The unit denotes a concurrent body acting as a subunit. Such bodies + -- are generally rewritten into null statements. The proper entity is + -- that of the "original node". + + elsif Nkind (N) = N_Subunit + and then Nkind (Proper_Body (N)) = N_Null_Statement + and then Nkind_In (Original_Node (Proper_Body (N)), N_Protected_Body, + N_Task_Body) + then + return Defining_Entity (Original_Node (Proper_Body (N))); -- Otherwise the proper entity is the defining entity else - return Defining_Entity (N, Concurrent_Subunit => True); + return Defining_Entity (N); end if; end Find_Unit_Entity; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9ca80aafda7..4de41d3e6dd 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5867,11 +5867,7 @@ package body Sem_Util is -- Defining_Entity -- --------------------- - function Defining_Entity - (N : Node_Id; - Empty_On_Errors : Boolean := False; - Concurrent_Subunit : Boolean := False) return Entity_Id - is + function Defining_Entity (N : Node_Id) return Entity_Id is begin case Nkind (N) is when N_Abstract_Subprogram_Declaration @@ -5922,24 +5918,11 @@ package body Sem_Util is => return Defining_Identifier (N); - when N_Subunit => - declare - Bod : constant Node_Id := Proper_Body (N); - Orig_Bod : constant Node_Id := Original_Node (Bod); - - begin - -- Retrieve the entity of the original protected or task body - -- if requested by the caller. + when N_Compilation_Unit => + return Defining_Entity (Unit (N)); - if Concurrent_Subunit - and then Nkind (Bod) = N_Null_Statement - and then Nkind_In (Orig_Bod, N_Protected_Body, N_Task_Body) - then - return Defining_Entity (Orig_Bod); - else - return Defining_Entity (Bod); - end if; - end; + when N_Subunit => + return Defining_Entity (Proper_Body (N)); when N_Function_Instantiation | N_Function_Specification @@ -5965,14 +5948,10 @@ package body Sem_Util is -- can continue semantic analysis. elsif Nam = Error then - if Empty_On_Errors then - return Empty; - else - Err := Make_Temporary (Sloc (N), 'T'); - Set_Defining_Unit_Name (N, Err); + Err := Make_Temporary (Sloc (N), 'T'); + Set_Defining_Unit_Name (N, Err); - return Err; - end if; + return Err; -- If not an entity, get defining identifier @@ -5987,11 +5966,7 @@ package body Sem_Util is return Entity (Identifier (N)); when others => - if Empty_On_Errors then - return Empty; - else - raise Program_Error; - end if; + raise Program_Error; end case; end Defining_Entity; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 7df81405632..dc5e57b0bf6 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -554,10 +554,7 @@ package Sem_Util is -- in the case of a descendant of a generic formal type (returns Int'Last -- instead of 0). - function Defining_Entity - (N : Node_Id; - Empty_On_Errors : Boolean := False; - Concurrent_Subunit : Boolean := False) return Entity_Id; + function Defining_Entity (N : Node_Id) return Entity_Id; -- Given a declaration N, returns the associated defining entity. If the -- declaration has a specification, the entity is obtained from the -- specification. If the declaration has a defining unit name, then the @@ -568,22 +565,6 @@ package Sem_Util is -- local entities declared during loop expansion. These entities need -- debugging information, generated through Qualify_Entity_Names, and -- the loop declaration must be placed in the table Name_Qualify_Units. - -- - -- Set flag Empty_On_Error to change the behavior of this routine as - -- follows: - -- - -- * True - A declaration that lacks a defining entity returns Empty. - -- A node that does not allow for a defining entity returns Empty. - -- - -- * False - A declaration that lacks a defining entity is given a new - -- internally generated entity which is subsequently returned. A node - -- that does not allow for a defining entity raises Program_Error. - -- - -- The former semantics is appropriate for the back end; the latter - -- semantics is appropriate for the front end. - -- - -- Set flag Concurrent_Subunit to handle rewritings of concurrent bodies - -- which act as subunits. Such bodies are generally rewritten as null. function Denotes_Discriminant (N : Node_Id; -- 2.30.2