From: Eric Botcazou Date: Sat, 12 Oct 2019 14:49:21 +0000 (+0000) Subject: re PR ada/91995 (gnat miscompilation and bootstrap failure on m68k-linux) X-Git-Tag: releases/gcc-9.3.0~553 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=72c1a8216d2f1706fad8206043104a6bb27396f4;p=thirdparty%2Fgcc.git 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_spark.adb (Check_Callable_Body): Likewise. (Check_Package_Body): Likewise. * 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: r276917 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f56d13cfb6e9..64ff4397fd40 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +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_spark.adb (Check_Callable_Body): Likewise. + (Check_Package_Body): Likewise. + * 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 (annotate_value) : Really test the diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index a5e821da1b42..340aa49bd11f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4256,16 +4256,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 b74f88d0461e..ee0c49ba40c3 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -5544,13 +5544,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_spark.adb b/gcc/ada/sem_spark.adb index cfa6df818541..439d29fe9dc4 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -804,7 +804,7 @@ package body Sem_SPARK is if Present (SPARK_Pragma (Defining_Entity (Body_N))) then if Get_SPARK_Mode_From_Annotation - (SPARK_Pragma (Defining_Entity (Body_N, False))) /= Opt.On + (SPARK_Pragma (Defining_Entity (Body_N))) /= Opt.On then return; end if; @@ -1914,7 +1914,7 @@ package body Sem_SPARK is CorSp : Node_Id; begin - if Present (SPARK_Pragma (Defining_Entity (Pack, False))) then + if Present (SPARK_Pragma (Defining_Entity (Pack))) then if Get_SPARK_Mode_From_Annotation (SPARK_Pragma (Defining_Entity (Pack))) /= Opt.On then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 16c671111e4f..eedfaf1376ee 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5827,11 +5827,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 @@ -5882,24 +5878,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 @@ -5925,14 +5908,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 @@ -5947,11 +5926,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 4e4d4ba88265..f098ea44d973 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -543,10 +543,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 @@ -557,22 +554,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;