Commit 519e9fdf by Arnaud Charlet

[multiple changes]

2016-06-14  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (Check_A_Call): Do nothing if the callee is
	(or is in) an instance, and the caller is outside.  Misc cleanup.

2016-06-14  Javier Miranda  <miranda@adacore.com>

	* sem_ch4.adb (Analyze_Quantified_Expression):
	Generating C code avoid spurious warning on loop variable of
	inlinined postconditions.

From-SVN: r237438
parent 64f5d139
2016-06-14 Bob Duff <duff@adacore.com>
* sem_elab.adb (Check_A_Call): Do nothing if the callee is
(or is in) an instance, and the caller is outside. Misc cleanup.
2016-06-14 Javier Miranda <miranda@adacore.com>
* sem_ch4.adb (Analyze_Quantified_Expression):
Generating C code avoid spurious warning on loop variable of
inlinined postconditions.
2016-06-14 Javier Miranda <miranda@adacore.com> 2016-06-14 Javier Miranda <miranda@adacore.com>
* sem_attr.adb (Analyze_Attribute_Old_Result): Adding assertion. * sem_attr.adb (Analyze_Attribute_Old_Result): Adding assertion.
......
...@@ -3917,7 +3917,16 @@ package body Sem_Ch4 is ...@@ -3917,7 +3917,16 @@ package body Sem_Ch4 is
if Warn_On_Suspicious_Contract if Warn_On_Suspicious_Contract
and then not Referenced (Loop_Id, Cond) and then not Referenced (Loop_Id, Cond)
then then
Error_Msg_N ("?T?unused variable &", Loop_Id); -- Generating C this check causes spurious warnings on inlined
-- postconditions; we can safely disable it because this check
-- was previously performed when analying the internally built
-- postconditions procedure.
if Modify_Tree_For_C and then In_Inlined_Body then
null;
else
Error_Msg_N ("?T?unused variable &", Loop_Id);
end if;
end if; end if;
-- Diagnose a possible misuse of the SOME existential quantifier. When -- Diagnose a possible misuse of the SOME existential quantifier. When
......
...@@ -516,11 +516,11 @@ package body Sem_Elab is ...@@ -516,11 +516,11 @@ package body Sem_Elab is
Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference; Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference;
-- Indicates if we have Access attribute case -- Indicates if we have Access attribute case
Variable_Case : constant Boolean := function Call_To_Instance_From_Outside
Nkind (N) in N_Has_Entity (Ent : Entity_Id) return Boolean;
and then Present (Entity (N)) -- True if we're calling an instance of a generic subprogram, or a
and then Ekind (Entity (N)) = E_Variable; -- subprogram in an instance of a generic package, and the call is
-- Indicates if we have variable reference case -- outside that instance.
procedure Elab_Warning procedure Elab_Warning
(Msg_D : String; (Msg_D : String;
...@@ -531,6 +531,36 @@ package body Sem_Elab is ...@@ -531,6 +531,36 @@ package body Sem_Elab is
-- warning (output if Msg_D is non-null and Elab_Warnings is set), -- warning (output if Msg_D is non-null and Elab_Warnings is set),
-- Msg_S is an info message (output if Elab_Info_Messages is set. -- Msg_S is an info message (output if Elab_Info_Messages is set.
function Find_W_Scope return Entity_Id;
-- Find top level scope for called entity (not following renamings
-- or derivations). This is where the Elaborate_All will go if it is
-- needed. We start with the called entity, except in the case of an
-- initialization procedure outside the current package, where the init
-- proc is in the root package, and we start from the entity of the name
-- in the call.
-----------------------------------
-- Call_To_Instance_From_Outside --
-----------------------------------
function Call_To_Instance_From_Outside
(Ent : Entity_Id) return Boolean is
X : Entity_Id := Ent;
begin
loop
if X = Standard_Standard then
return False;
end if;
if Is_Generic_Instance (X) then
return not In_Open_Scopes (X);
end if;
X := Scope (X);
end loop;
end Call_To_Instance_From_Outside;
------------------ ------------------
-- Elab_Warning -- -- Elab_Warning --
------------------ ------------------
...@@ -565,7 +595,38 @@ package body Sem_Elab is ...@@ -565,7 +595,38 @@ package body Sem_Elab is
end if; end if;
end Elab_Warning; end Elab_Warning;
-- Local variables ------------------
-- Find_W_Scope --
------------------
function Find_W_Scope return Entity_Id is
Refed_Ent : constant Entity_Id := Get_Referenced_Ent (N);
W_Scope : Entity_Id;
begin
if Is_Init_Proc (Refed_Ent)
and then not In_Same_Extended_Unit (N, Refed_Ent)
then
W_Scope := Scope (Refed_Ent);
else
W_Scope := E;
end if;
-- Now loop through scopes to get to the enclosing compilation unit
while not Is_Compilation_Unit (W_Scope) loop
W_Scope := Scope (W_Scope);
end loop;
return W_Scope;
end Find_W_Scope;
-- Locals
Variable_Case : constant Boolean :=
Nkind (N) in N_Has_Entity
and then Present (Entity (N))
and then Ekind (Entity (N)) = E_Variable;
-- Indicates if we have variable reference case
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
...@@ -605,7 +666,7 @@ package body Sem_Elab is ...@@ -605,7 +666,7 @@ package body Sem_Elab is
Issue_In_SPARK : Boolean; Issue_In_SPARK : Boolean;
-- Flag set when a source entity is called during elaboration in SPARK -- Flag set when a source entity is called during elaboration in SPARK
W_Scope : Entity_Id; W_Scope : constant Entity_Id := Find_W_Scope;
-- Top level scope of directly called entity for subprogram. This -- Top level scope of directly called entity for subprogram. This
-- differs from E_Scope in the case where renamings or derivations -- differs from E_Scope in the case where renamings or derivations
-- are involved, since it does not follow these links. W_Scope is -- are involved, since it does not follow these links. W_Scope is
...@@ -717,17 +778,11 @@ package body Sem_Elab is ...@@ -717,17 +778,11 @@ package body Sem_Elab is
and then (Is_Child_Unit (E_Scope) and then (Is_Child_Unit (E_Scope)
or else Scope (E_Scope) = Standard_Standard); or else Scope (E_Scope) = Standard_Standard);
-- If we did not find a compilation unit, other than standard, pragma Assert (E_Scope /= Standard_Standard);
-- then nothing to check (happens in some instantiation cases)
if E_Scope = Standard_Standard then
return;
-- Otherwise move up a scope looking for compilation unit -- Move up a scope looking for compilation unit
else E_Scope := Scope (E_Scope);
E_Scope := Scope (E_Scope);
end if;
end loop; end loop;
-- No checks needed for pure or preelaborated compilation units -- No checks needed for pure or preelaborated compilation units
...@@ -755,29 +810,6 @@ package body Sem_Elab is ...@@ -755,29 +810,6 @@ package body Sem_Elab is
return; return;
end if; end if;
-- Find top level scope for called entity (not following renamings
-- or derivations). This is where the Elaborate_All will go if it is
-- needed. We start with the called entity, except in the case of an
-- initialization procedure outside the current package, where the init
-- proc is in the root package, and we start from the entity of the name
-- in the call.
declare
Ent : constant Entity_Id := Get_Referenced_Ent (N);
begin
if Is_Init_Proc (Ent) and then not In_Same_Extended_Unit (N, Ent) then
W_Scope := Scope (Ent);
else
W_Scope := E;
end if;
end;
-- Now loop through scopes to get to the enclosing compilation unit
while not Is_Compilation_Unit (W_Scope) loop
W_Scope := Scope (W_Scope);
end loop;
-- Case of entity is in same unit as call or instantiation. In the -- Case of entity is in same unit as call or instantiation. In the
-- instantiation case, W_Scope may be different from E_Scope; we want -- instantiation case, W_Scope may be different from E_Scope; we want
-- the unit in which the instantiation occurs, since we're analyzing -- the unit in which the instantiation occurs, since we're analyzing
...@@ -806,11 +838,11 @@ package body Sem_Elab is ...@@ -806,11 +838,11 @@ package body Sem_Elab is
return; return;
end if; end if;
-- Nothing to do for a generic instance, because in this case the -- Nothing to do for a generic instance, because a call to an instance
-- checking was at the point of instantiation of the generic However, -- cannot fail the elaboration check, because the body of the instance
-- this shortcut is only applicable in static mode. -- is always elaborated immediately after the spec.
if Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then if Call_To_Instance_From_Outside (Ent) then
return; return;
end if; end if;
......
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