[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 14 Jun 2016 12:39:11 +0000 (14:39 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 14 Jun 2016 12:39:11 +0000 (14:39 +0200)
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

gcc/ada/ChangeLog
gcc/ada/sem_ch4.adb
gcc/ada/sem_elab.adb

index e0af917758d53634b50dd0f0df5eb6b69df9cd17..ef70ce53fd6ec4ad1bd9417eb7e96088cc81adcc 100644 (file)
@@ -1,3 +1,14 @@
+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.
index 20d1a740765632b7f34a63e34f0f8b30a55d60a3..edcfee226d50d5602f247fdb53022ef649351664 100644 (file)
@@ -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
index 783f6dda2063b501b600483e9763055865208928..27fed6f0a477d8259919f01fc5bc502cf3fef6c1 100644 (file)
@@ -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;