Skip to content

R
riscv-gcc-1
Commit 519e9fdf by Arnaud Charlet
Options

[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
Showing with 96 additions and 44 deletions
gcc/ada/ChangeLog
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>
* sem_attr.adb (Analyze_Attribute_Old_Result): Adding assertion.
......
gcc/ada/sem_ch4.adb
......@@ -3917,7 +3917,16 @@ package body Sem_Ch4 is
if Warn_On_Suspicious_Contract
and then not Referenced (Loop_Id, Cond)
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;
-- Diagnose a possible misuse of the SOME existential quantifier. When
......
gcc/ada/sem_elab.adb
......@@ -516,11 +516,11 @@ package body Sem_Elab is
Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference;
-- Indicates if we have Access attribute case
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
function Call_To_Instance_From_Outside
(Ent : Entity_Id) return Boolean;
-- True if we're calling an instance of a generic subprogram, or a
-- subprogram in an instance of a generic package, and the call is
-- outside that instance.
procedure Elab_Warning
(Msg_D : String;
......@@ -531,6 +531,36 @@ package body Sem_Elab is
-- 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.
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 --
------------------
......@@ -565,7 +595,38 @@ package body Sem_Elab is
end if;
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);
......@@ -605,7 +666,7 @@ package body Sem_Elab is
Issue_In_SPARK : Boolean;
-- 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
-- differs from E_Scope in the case where renamings or derivations
-- are involved, since it does not follow these links. W_Scope is
......@@ -717,17 +778,11 @@ package body Sem_Elab is
and then (Is_Child_Unit (E_Scope)
or else Scope (E_Scope) = Standard_Standard);
-- If we did not find a compilation unit, other than standard,
-- then nothing to check (happens in some instantiation cases)
if E_Scope = Standard_Standard then
return;
pragma Assert (E_Scope /= Standard_Standard);
-- Otherwise move up a scope looking for compilation unit
-- Move up a scope looking for compilation unit
else
E_Scope := Scope (E_Scope);
end if;
E_Scope := Scope (E_Scope);
end loop;
-- No checks needed for pure or preelaborated compilation units
......@@ -755,29 +810,6 @@ package body Sem_Elab is
return;
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
-- instantiation case, W_Scope may be different from E_Scope; we want
-- the unit in which the instantiation occurs, since we're analyzing
......@@ -806,11 +838,11 @@ package body Sem_Elab is
return;
end if;
-- Nothing to do for a generic instance, because in this case the
-- checking was at the point of instantiation of the generic However,
-- this shortcut is only applicable in static mode.
-- Nothing to do for a generic instance, because a call to an instance
-- cannot fail the elaboration check, because the body of the instance
-- 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;
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