Commit 87fd6836 by Arnaud Charlet

[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
parent b35e5dcb
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
......
......@@ -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,13 +529,14 @@ 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
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,17 +568,19 @@ 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)) =
and then Nkind (Unit_Declaration_Node (Scop)) =
N_Generic_Subprogram_Declaration
then
null;
......
......@@ -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.
......
......@@ -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 --
------------------------
......
......@@ -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
......
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