+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
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
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
-- 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;
-- 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
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.
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 --
------------------------
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