[Ada] Fix PR ada/91995

Message ID 5998952.OneQxh4Rtu@polaris
State New
Headers show
Series
  • [Ada] Fix PR ada/91995
Related show

Commit Message

Eric Botcazou Oct. 12, 2019, 2:51 p.m.
The function Defining_Entity recently gained new parameters with default 
values, namely Empty_On_Errors and Concurrent_Subunit.  It turns out that 
these new parameters are not really necessary and can be easily removed,
which will also save a few bytes in the final binary.

Tested on x86_64-suse-linux, applied on all active branches.


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.

-- 
Eric Botcazou

Patch

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 276875)
+++ sem_ch8.adb	(working copy)
@@ -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;
Index: sem_elab.adb
===================================================================
--- sem_elab.adb	(revision 276875)
+++ sem_elab.adb	(working copy)
@@ -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;
 
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 276875)
+++ sem_util.adb	(working copy)
@@ -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;
 
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 276875)
+++ sem_util.ads	(working copy)
@@ -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;