From ea3fc544579ba489ef516cf582792b475ce78b67 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 14 Jun 2016 12:39:11 +0000 Subject: [PATCH] 2016-06-14 Bob Duff * 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 * sem_ch4.adb (Analyze_Quantified_Expression): Generating C code avoid spurious warning on loop variable of inlinined postconditions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@237438 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 11 +++++ gcc/ada/sem_ch4.adb | 11 ++++- gcc/ada/sem_elab.adb | 118 ++++++++++++++++++++++++++++++++------------------- 3 files changed, 96 insertions(+), 44 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e0af917758d..ef70ce53fd6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2016-06-14 Bob Duff + + * 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 + + * sem_ch4.adb (Analyze_Quantified_Expression): + Generating C code avoid spurious warning on loop variable of + inlinined postconditions. + 2016-06-14 Javier Miranda * sem_attr.adb (Analyze_Attribute_Old_Result): Adding assertion. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 20d1a740765..edcfee226d5 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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 diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 783f6dda206..27fed6f0a47 100644 --- a/gcc/ada/sem_elab.adb +++ b/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; -- 2.11.4.GIT