Re: [Patch, Fortran] PR 85599: warn about short-circuiting of logical expressions for non-pure functions

[Janus Weil <janus@gcc.gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1854 bytes --]

2018-07-17 9:52 GMT+02:00 Janus Weil <janus@gcc.gnu.org>:
>> 2018-07-16 21:50 GMT+02:00 Thomas Koenig <tkoenig@netcologne.de>:
>>> What I would suggest is to enable -Wfunction-eliminiation with
>>> -Wextra and also use that for your new warning.
>>
>> Thanks for the comments. Makes sense. Updated patch attached.
>
>
> Huh, after actually trying -Wfunction-elimination, I'm not so sure any
> more if it really makes sense to throw the new warnings in there,
> mainly for two reasons:
>
> a) -Wfunction-elimination is slightly different, in that it warns
> about removing *any* kind of function, not just impure ones. This
> makes it pretty verbose, and I'm not sure why one would need to know
> if a pure function call is removed.
> b) It gives warnings on places that I don't understand. Simple example:
>
> subroutine sub(r)
>    implicit none
>    real, intent(in) :: r
>    if ((abs(r) > 1e6) .or. (abs(r) < 1e-6)) then
>       print *, "rrr"
>    end if
> end
>
> Compiling this with "gfortran-8 -O1 -Wfunction-elimination" gives me:
>
>     if ((abs(r) > 1e6) .or. (abs(r) < 1e-6)) then
>         1
> Warning: Removing call to function ‘abs’ at (1) [-Wfunction-elimination]
>
>
> Why can I remove the call to ABS there? If I read the dump correctly,
> then the two calls to ABS are optimized into a single one, which is
> used for both comparisons via a temporary. Is that what the warning is
> trying to tell me? And if yes, why should I care (if the function is
> pure)? The middle-end certainly does tons of optimizations that
> rearrange various expressions, without warning me about it ...
>
> In other words: Does it make sense to tone down
> -Wfunction-elimination, by only warning about impure functions?

Here is an update of the patch which does that. Regtesting now ...

Cheers,
Janus

[-- Attachment #2: pr85599_v6.diff --]
[-- Type: text/x-patch, Size: 8262 bytes --]

Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c	(revision 262764)
+++ gcc/fortran/dump-parse-tree.c	(working copy)
@@ -716,6 +716,8 @@ show_attr (symbol_attribute *attr, const char * mo
     fputs (" ELEMENTAL", dumpfile);
   if (attr->pure)
     fputs (" PURE", dumpfile);
+  if (attr->implicit_pure)
+    fputs (" IMPLICIT_PURE", dumpfile);
   if (attr->recursive)
     fputs (" RECURSIVE", dumpfile);
 
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c	(revision 262764)
+++ gcc/fortran/frontend-passes.c	(working copy)
@@ -840,17 +840,17 @@ create_var (gfc_expr * e, const char *vname)
 static void
 do_warn_function_elimination (gfc_expr *e)
 {
-  if (e->expr_type != EXPR_FUNCTION)
-    return;
-  if (e->value.function.esym)
-    gfc_warning (OPT_Wfunction_elimination,
-		 "Removing call to function %qs at %L",
-		 e->value.function.esym->name, &(e->where));
-  else if (e->value.function.isym)
-    gfc_warning (OPT_Wfunction_elimination,
-		 "Removing call to function %qs at %L",
-		 e->value.function.isym->name, &(e->where));
+  const char *name;
+  if (e->expr_type == EXPR_FUNCTION && !gfc_pure_function (e, &name) && !gfc_implicit_pure_function (e))
+   {
+      if (name)
+         gfc_warning (OPT_Wfunction_elimination, "Removing call to impure function %qs at %L", name, &(e->where));
+      else
+         gfc_warning (OPT_Wfunction_elimination, "Removing call to impure function at %L", &(e->where));
+   }
 }
+
+
 /* Callback function for the code walker for doing common function
    elimination.  This builds up the list of functions in the expression
    and goes through them to detect duplicates, which it then replaces
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 262764)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -3275,6 +3275,8 @@ bool gfc_resolve_intrinsic (gfc_symbol *, locus *)
 bool gfc_explicit_interface_required (gfc_symbol *, char *, int);
 extern int gfc_do_concurrent_flag;
 const char* gfc_lookup_function_fuzzy (const char *, gfc_symtree *);
+int gfc_pure_function (gfc_expr *e, const char **name);
+int gfc_implicit_pure_function (gfc_expr *e);
 
 
 /* array.c */
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi	(revision 262764)
+++ gcc/fortran/gfortran.texi	(working copy)
@@ -1177,6 +1177,7 @@ might in some way or another become visible to the
 @menu
 * KIND Type Parameters::
 * Internal representation of LOGICAL variables::
+* Evaluation of logical expressions::
 * Thread-safety of the runtime library::
 * Data consistency and durability::
 * Files opened without an explicit ACTION= specifier::
@@ -1251,6 +1252,19 @@ values: @code{1} for @code{.TRUE.} and @code{0} fo
 See also @ref{Argument passing conventions} and @ref{Interoperability with C}.
 
 
+@node Evaluation of logical expressions
+@section Evaluation of logical expressions
+
+The Fortran standard does not require the compiler to evaluate all parts of an
+expression, if they do not contribute to the final result. For logical
+expressions with @code{.AND.} or @code{.OR.} operators, in particular, GNU
+Fortran will optimize out function calls (even to impure functions) if the
+result of the expression can be established without them. However, since not
+all compilers do that, and such an optimization can potentially modify the
+program flow and subsequent results, GNU Fortran throws warnings for such
+situations with the @option{-Wfunction-elimination} flag.
+
+
 @node Thread-safety of the runtime library
 @section Thread-safety of the runtime library
 @cindex thread-safety, threads
Index: gcc/fortran/invoke.texi
===================================================================
--- gcc/fortran/invoke.texi	(revision 262764)
+++ gcc/fortran/invoke.texi	(working copy)
@@ -1058,6 +1058,7 @@ off via @option{-Wno-align-commons}. See also @opt
 @cindex warnings, function elimination
 Warn if any calls to functions are eliminated by the optimizations
 enabled by the @option{-ffrontend-optimize} option.
+This option is implied by @option{-Wextra}.
 
 @item -Wrealloc-lhs
 @opindex @code{Wrealloc-lhs}
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt	(revision 262764)
+++ gcc/fortran/lang.opt	(working copy)
@@ -250,7 +250,7 @@ Fortran Var(flag_warn_frontend_loop_interchange)
 Warn if loops have been interchanged.
 
 Wfunction-elimination
-Fortran Warning Var(warn_function_elimination)
+Fortran Warning Var(warn_function_elimination) LangEnabledBy(Fortran,Wextra)
 Warn about function call elimination.
 
 Wimplicit-interface
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 262764)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2941,8 +2941,8 @@ is_external_proc (gfc_symbol *sym)
 static int
 pure_stmt_function (gfc_expr *, gfc_symbol *);
 
-static int
-pure_function (gfc_expr *e, const char **name)
+int
+gfc_pure_function (gfc_expr *e, const char **name)
 {
   int pure;
   gfc_component *comp;
@@ -2982,6 +2982,21 @@ pure_stmt_function (gfc_expr *, gfc_symbol *);
 }
 
 
+/* Check if the expression is a reference to an implicitly pure function.  */
+
+int
+gfc_implicit_pure_function (gfc_expr *e)
+{
+  gfc_component *comp = gfc_get_proc_ptr_comp (e);
+  if (comp)
+    return gfc_implicit_pure (comp->ts.interface);
+  else if (e->value.function.esym)
+    return gfc_implicit_pure (e->value.function.esym);
+  else
+    return 0;
+}
+
+
 static bool
 impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
 		 int *f ATTRIBUTE_UNUSED)
@@ -2996,7 +3011,7 @@ impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
 	|| e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
     return false;
 
-  return pure_function (e, &name) ? false : true;
+  return gfc_pure_function (e, &name) ? false : true;
 }
 
 
@@ -3012,7 +3027,7 @@ pure_stmt_function (gfc_expr *e, gfc_symbol *sym)
 static bool check_pure_function (gfc_expr *e)
 {
   const char *name = NULL;
-  if (!pure_function (e, &name) && name)
+  if (!gfc_pure_function (e, &name) && name)
     {
       if (forall_flag)
 	{
@@ -3034,7 +3049,8 @@ static bool check_pure_function (gfc_expr *e)
 		     "within a PURE procedure", name, &e->where);
 	  return false;
 	}
-      gfc_unset_implicit_pure (NULL);
+      if (!gfc_implicit_pure_function (e))
+	gfc_unset_implicit_pure (NULL);
     }
   return true;
 }
@@ -3822,6 +3838,40 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop
 }
 
 
+/* Callback finding an impure function as an operand to an .and. or
+   .or.  expression.  Remember the last function warned about to
+   avoid double warnings when recursing.  */
+
+static int
+impure_function_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+			  void *data)
+{
+  gfc_expr *f = *e;
+  const char *name;
+  static gfc_expr *last = NULL;
+  bool *found = (bool *) data;
+
+  if (f->expr_type == EXPR_FUNCTION)
+    {
+      *found = 1;
+      if (f != last && !gfc_pure_function (f, &name) && !gfc_implicit_pure_function (f))
+	{
+	  if (name)
+	    gfc_warning (OPT_Wfunction_elimination,
+			 "Impure function %qs at %L might not be evaluated",
+			 name, &f->where);
+	  else
+	    gfc_warning (OPT_Wfunction_elimination,
+			 "Impure function at %L might not be evaluated",
+			 &f->where);
+	}
+      last = f;
+    }
+
+  return 0;
+}
+
+
 /* Resolve an operator expression node.  This can involve replacing the
    operation with a user defined function call.  */
 
@@ -3930,6 +3980,14 @@ resolve_operator (gfc_expr *e)
 	    gfc_convert_type (op1, &e->ts, 2);
 	  else if (op2->ts.kind < e->ts.kind)
 	    gfc_convert_type (op2, &e->ts, 2);
+
+	  if (e->value.op.op == INTRINSIC_AND || e->value.op.op == INTRINSIC_OR)
+	    {
+	      /* Warn about short-circuiting
+	         with impure function as second operand.  */
+	      bool op2_f = false;
+	      gfc_expr_walker (&op2, impure_function_callback, &op2_f);
+	    }
 	  break;
 	}