Commit 9aa357c7 by Eric Botcazou Committed by Eric Botcazou

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
parent 853ce7c0
2019-10-12 Eric Botcazou <ebotcazou@adacore.com>
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 <ebotcazou@adacore.com> 2019-10-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (elaborate_reference_1): Specifically deal with * gcc-interface/decl.c (elaborate_reference_1): Specifically deal with
......
...@@ -4290,16 +4290,14 @@ package body Sem_Ch8 is ...@@ -4290,16 +4290,14 @@ package body Sem_Ch8 is
-- Common case for compilation unit -- Common case for compilation unit
elsif Defining_Entity (N => Parent (N), elsif Defining_Entity (Parent (N)) = Current_Scope then
Empty_On_Errors => True) = Current_Scope
then
null; null;
else else
-- If declaration appears in some other scope, it must be in some -- If declaration appears in some other scope, it must be in some
-- parent unit when compiling a child. -- 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 if not In_Open_Scopes (Pack) then
null; null;
......
...@@ -9103,13 +9103,23 @@ package body Sem_Elab is ...@@ -9103,13 +9103,23 @@ package body Sem_Elab is
N_Procedure_Instantiation) N_Procedure_Instantiation)
and then Nkind (Context) = N_Compilation_Unit and then Nkind (Context) = N_Compilation_Unit
then then
return return Related_Instance (Defining_Entity (N));
Related_Instance (Defining_Entity (N, Concurrent_Subunit => True));
-- 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 -- Otherwise the proper entity is the defining entity
else else
return Defining_Entity (N, Concurrent_Subunit => True); return Defining_Entity (N);
end if; end if;
end Find_Unit_Entity; end Find_Unit_Entity;
......
...@@ -5867,11 +5867,7 @@ package body Sem_Util is ...@@ -5867,11 +5867,7 @@ package body Sem_Util is
-- Defining_Entity -- -- Defining_Entity --
--------------------- ---------------------
function Defining_Entity function Defining_Entity (N : Node_Id) return Entity_Id is
(N : Node_Id;
Empty_On_Errors : Boolean := False;
Concurrent_Subunit : Boolean := False) return Entity_Id
is
begin begin
case Nkind (N) is case Nkind (N) is
when N_Abstract_Subprogram_Declaration when N_Abstract_Subprogram_Declaration
...@@ -5922,24 +5918,11 @@ package body Sem_Util is ...@@ -5922,24 +5918,11 @@ package body Sem_Util is
=> =>
return Defining_Identifier (N); return Defining_Identifier (N);
when N_Subunit => when N_Compilation_Unit =>
declare return Defining_Entity (Unit (N));
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.
if Concurrent_Subunit when N_Subunit =>
and then Nkind (Bod) = N_Null_Statement return Defining_Entity (Proper_Body (N));
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_Function_Instantiation when N_Function_Instantiation
| N_Function_Specification | N_Function_Specification
...@@ -5965,14 +5948,10 @@ package body Sem_Util is ...@@ -5965,14 +5948,10 @@ package body Sem_Util is
-- can continue semantic analysis. -- can continue semantic analysis.
elsif Nam = Error then elsif Nam = Error then
if Empty_On_Errors then Err := Make_Temporary (Sloc (N), 'T');
return Empty; Set_Defining_Unit_Name (N, Err);
else
Err := Make_Temporary (Sloc (N), 'T');
Set_Defining_Unit_Name (N, Err);
return Err; return Err;
end if;
-- If not an entity, get defining identifier -- If not an entity, get defining identifier
...@@ -5987,11 +5966,7 @@ package body Sem_Util is ...@@ -5987,11 +5966,7 @@ package body Sem_Util is
return Entity (Identifier (N)); return Entity (Identifier (N));
when others => when others =>
if Empty_On_Errors then raise Program_Error;
return Empty;
else
raise Program_Error;
end if;
end case; end case;
end Defining_Entity; end Defining_Entity;
......
...@@ -554,10 +554,7 @@ package Sem_Util is ...@@ -554,10 +554,7 @@ package Sem_Util is
-- in the case of a descendant of a generic formal type (returns Int'Last -- in the case of a descendant of a generic formal type (returns Int'Last
-- instead of 0). -- instead of 0).
function Defining_Entity function Defining_Entity (N : Node_Id) return Entity_Id;
(N : Node_Id;
Empty_On_Errors : Boolean := False;
Concurrent_Subunit : Boolean := False) return Entity_Id;
-- Given a declaration N, returns the associated defining entity. If the -- Given a declaration N, returns the associated defining entity. If the
-- declaration has a specification, the entity is obtained from the -- declaration has a specification, the entity is obtained from the
-- specification. If the declaration has a defining unit name, then the -- specification. If the declaration has a defining unit name, then the
...@@ -568,22 +565,6 @@ package Sem_Util is ...@@ -568,22 +565,6 @@ package Sem_Util is
-- local entities declared during loop expansion. These entities need -- local entities declared during loop expansion. These entities need
-- debugging information, generated through Qualify_Entity_Names, and -- debugging information, generated through Qualify_Entity_Names, and
-- the loop declaration must be placed in the table Name_Qualify_Units. -- 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 function Denotes_Discriminant
(N : Node_Id; (N : Node_Id;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment