[multiple changes]

2016-04-19  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Entry_Call): If the entry has
	preconditions it is rewritten by means of a wrapper that
	incorporates the original call. Before rewriting generate a
	reference to the entry being called to prevent spurious warnings
	and provide correct cross-reference information.

2016-04-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_disp.adb (Check_Dispatching_Context): Code cleanup. Add
	local constant Scop. Ignore any internally generated loops when
	performing the check concerning an abstract subprogram call
	without a controlling argument.
	* sem_util.ads, sem_util.adb (Current_Scope_No_Loops): New routine.

From-SVN: r235192

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7c37bef..02ab369 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2016-04-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Resolve_Entry_Call): If the entry has
+       preconditions it is rewritten by means of a wrapper that
+       incorporates the original call. Before rewriting generate a
+       reference to the entry being called to prevent spurious warnings
+       and provide correct cross-reference information.
+
+2016-04-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_disp.adb (Check_Dispatching_Context): Code cleanup. Add
+       local constant Scop. Ignore any internally generated loops when
+       performing the check concerning an abstract subprogram call
+       without a controlling argument.
+       * sem_util.ads, sem_util.adb (Current_Scope_No_Loops): New routine.
+
 2016-04-19  Bob Duff  <duff@adacore.com>
 
        * sem_elab.adb (Check_A_Call): There are cases where we have No

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 2d9a746..4d8ef3f 100644 (file)
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -510,7 +510,6 @@ package body Sem_Disp is
 
       procedure Check_Dispatching_Context (Call : Node_Id) is
          Subp : constant Entity_Id := Entity (Name (Call));
-         Typ  : constant Entity_Id := Etype (Subp);
 
          procedure Abstract_Context_Error;
          --  Error for abstract call dispatching on result is not dispatching
@@ -530,14 +529,15 @@ package body Sem_Disp is
 
             else
                Error_Msg_N
-                 ("call to abstract procedure must be dispatching",
-                  N);
+                 ("call to abstract procedure must be dispatching", N);
             end if;
          end Abstract_Context_Error;
 
          --  Local variables
 
-         Par : Node_Id;
+         Scop : constant Entity_Id := Current_Scope_No_Loops;
+         Typ  : constant Entity_Id := Etype (Subp);
+         Par  : Node_Id;
 
       --  Start of processing for Check_Dispatching_Context
 
@@ -568,18 +568,20 @@ package body Sem_Disp is
             --  but will be legal in overridings of the operation.
 
             elsif In_Spec_Expression
-              and then (Is_Subprogram (Current_Scope)
-                 or else Chars (Current_Scope) = Name_Postcondition)
               and then
-                ((Nkind (Parent (Current_Scope)) = N_Procedure_Specification
-                   and then Null_Present (Parent (Current_Scope)))
-                 or else Is_Abstract_Subprogram (Current_Scope))
+                (Is_Subprogram (Scop)
+                  or else Chars (Scop) = Name_Postcondition)
+              and then
+                (Is_Abstract_Subprogram (Scop)
+                  or else
+                    (Nkind (Parent (Scop)) = N_Procedure_Specification
+                      and then Null_Present (Parent (Scop))))
             then
                null;
 
             elsif Ekind (Current_Scope) = E_Function
-              and then Nkind (Unit_Declaration_Node (Current_Scope)) =
-                                          N_Generic_Subprogram_Declaration
+              and then Nkind (Unit_Declaration_Node (Scop)) =
+                         N_Generic_Subprogram_Declaration
             then
                null;
 
@@ -969,8 +971,8 @@ package body Sem_Disp is
       --  if the associated tagged type is already frozen.
 
       Has_Dispatching_Parent :=
-         Present (Alias (Subp))
-           and then Is_Dispatching_Operation (Alias (Subp));
+        Present (Alias (Subp))
+          and then Is_Dispatching_Operation (Alias (Subp));
 
       if No (Tagged_Type) then
 

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 5a6d392..d6b9069 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7614,6 +7614,12 @@ package body Sem_Res is
         and then Present (Contract_Wrapper (Nam))
         and then Current_Scope /= Contract_Wrapper (Nam)
       then
+
+         --  Note the entity being called before rewriting the call, so that
+         --  it appears used at this point.
+
+         Generate_Reference (Nam, Entry_Name, 'r');
+
          --  Rewrite as call to the precondition wrapper, adding the task
          --  object to the list of actuals. If the call is to a member of an
          --  entry family, include the index as well.

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e57cd93..393ff73 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5143,6 +5143,29 @@ package body Sem_Util is
       end if;
    end Current_Scope;
 
+   ----------------------------
+   -- Current_Scope_No_Loops --
+   ----------------------------
+
+   function Current_Scope_No_Loops return Entity_Id is
+      S : Entity_Id;
+
+   begin
+      --  Examine the scope stack starting from the current scope and skip any
+      --  internally generated loops.
+
+      S := Current_Scope;
+      while Present (S) and then S /= Standard_Standard loop
+         if Ekind (S) = E_Loop and then not Comes_From_Source (S) then
+            S := Scope (S);
+         else
+            exit;
+         end if;
+      end loop;
+
+      return S;
+   end Current_Scope_No_Loops;
+
    ------------------------
    -- Current_Subprogram --
    ------------------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 494a9e4..df475cc 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -449,6 +449,9 @@ package Sem_Util is
    function Current_Scope return Entity_Id;
    --  Get entity representing current scope
 
+   function Current_Scope_No_Loops return Entity_Id;
+   --  Return the current scope ignoring internally generated loops
+
    function Current_Subprogram return Entity_Id;
    --  Returns current enclosing subprogram. If Current_Scope is a subprogram,
    --  then that is what is returned, otherwise the Enclosing_Subprogram of the