Commit 6457b1f0 by Janus Weil

re PR fortran/85599 (warn about short-circuiting of logical expressions for non-pure functions)

2018-07-18  Janus Weil  <janus@gcc.gnu.org>
	    Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/85599
	* dump-parse-tree.c (show_attr): Add handling of implicit_pure.
	* frontend-passes.c (do_warn_function_elimination): Do not warn for
	pure functions.
	* gfortran.h: Add prototypes for gfc_pure_function and
	gfc_implicit_pure_function.
	* gfortran.texi: Add chapter on evaluation of logical expressions.
	* invoke.texi: Mention that -Wfunction-elimination is implied
	by -Wextra.
	* lang.opt: Make -Wextra imply -Wfunction-elimination.
	* resolve.c (pure_function): Rename to gfc_pure_function.
	(gfc_implicit_pure_function): New function.
	(check_pure_function): Use it here.
	(impure_function_callback): New function.
	(resolve_operator): Call it via gfc_expr_walker.


2018-07-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/85599
	* gfortran.dg/function_optimize_5.f90: Add option
	'-faggressive-function-elimination' and update dg-warning clauses.
	* gfortran.dg/short_circuiting.f90: New test.

Co-Authored-By: Thomas Koenig <tkoenig@gcc.gnu.org>

From-SVN: r262860
parent c56e9727
2018-07-18 Janus Weil <janus@gcc.gnu.org>
Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85599
* dump-parse-tree.c (show_attr): Add handling of implicit_pure.
* frontend-passes.c (do_warn_function_elimination): Do not warn for
pure functions.
* gfortran.h: Add prototypes for gfc_pure_function and
gfc_implicit_pure_function.
* gfortran.texi: Add chapter on evaluation of logical expressions.
* invoke.texi: Mention that -Wfunction-elimination is implied
by -Wextra.
* lang.opt: Make -Wextra imply -Wfunction-elimination.
* resolve.c (pure_function): Rename to gfc_pure_function.
(gfc_implicit_pure_function): New function.
(check_pure_function): Use it here.
(impure_function_callback): New function.
(resolve_operator): Call it via gfc_expr_walker.
2018-07-16 Fritz Reese <fritzoreese@gmail.com> 2018-07-16 Fritz Reese <fritzoreese@gmail.com>
PR fortran/83184 PR fortran/83184
......
...@@ -716,6 +716,8 @@ show_attr (symbol_attribute *attr, const char * module) ...@@ -716,6 +716,8 @@ show_attr (symbol_attribute *attr, const char * module)
fputs (" ELEMENTAL", dumpfile); fputs (" ELEMENTAL", dumpfile);
if (attr->pure) if (attr->pure)
fputs (" PURE", dumpfile); fputs (" PURE", dumpfile);
if (attr->implicit_pure)
fputs (" IMPLICIT_PURE", dumpfile);
if (attr->recursive) if (attr->recursive)
fputs (" RECURSIVE", dumpfile); fputs (" RECURSIVE", dumpfile);
......
...@@ -840,17 +840,22 @@ create_var (gfc_expr * e, const char *vname) ...@@ -840,17 +840,22 @@ create_var (gfc_expr * e, const char *vname)
static void static void
do_warn_function_elimination (gfc_expr *e) do_warn_function_elimination (gfc_expr *e)
{ {
if (e->expr_type != EXPR_FUNCTION) const char *name;
return; if (e->expr_type == EXPR_FUNCTION
if (e->value.function.esym) && !gfc_pure_function (e, &name) && !gfc_implicit_pure_function (e))
gfc_warning (OPT_Wfunction_elimination, {
"Removing call to function %qs at %L", if (name)
e->value.function.esym->name, &(e->where)); gfc_warning (OPT_Wfunction_elimination,
else if (e->value.function.isym) "Removing call to impure function %qs at %L", name,
gfc_warning (OPT_Wfunction_elimination, &(e->where));
"Removing call to function %qs at %L", else
e->value.function.isym->name, &(e->where)); gfc_warning (OPT_Wfunction_elimination,
"Removing call to impure function at %L",
&(e->where));
}
} }
/* Callback function for the code walker for doing common function /* Callback function for the code walker for doing common function
elimination. This builds up the list of functions in the expression elimination. This builds up the list of functions in the expression
and goes through them to detect duplicates, which it then replaces and goes through them to detect duplicates, which it then replaces
......
...@@ -3275,6 +3275,8 @@ bool gfc_resolve_intrinsic (gfc_symbol *, locus *); ...@@ -3275,6 +3275,8 @@ bool gfc_resolve_intrinsic (gfc_symbol *, locus *);
bool gfc_explicit_interface_required (gfc_symbol *, char *, int); bool gfc_explicit_interface_required (gfc_symbol *, char *, int);
extern int gfc_do_concurrent_flag; extern int gfc_do_concurrent_flag;
const char* gfc_lookup_function_fuzzy (const char *, gfc_symtree *); 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 */ /* array.c */
......
...@@ -1177,6 +1177,7 @@ might in some way or another become visible to the programmer. ...@@ -1177,6 +1177,7 @@ might in some way or another become visible to the programmer.
@menu @menu
* KIND Type Parameters:: * KIND Type Parameters::
* Internal representation of LOGICAL variables:: * Internal representation of LOGICAL variables::
* Evaluation of logical expressions::
* Thread-safety of the runtime library:: * Thread-safety of the runtime library::
* Data consistency and durability:: * Data consistency and durability::
* Files opened without an explicit ACTION= specifier:: * Files opened without an explicit ACTION= specifier::
...@@ -1251,6 +1252,19 @@ values: @code{1} for @code{.TRUE.} and @code{0} for ...@@ -1251,6 +1252,19 @@ values: @code{1} for @code{.TRUE.} and @code{0} for
See also @ref{Argument passing conventions} and @ref{Interoperability with C}. 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 @node Thread-safety of the runtime library
@section Thread-safety of the runtime library @section Thread-safety of the runtime library
@cindex thread-safety, threads @cindex thread-safety, threads
......
...@@ -1056,8 +1056,9 @@ off via @option{-Wno-align-commons}. See also @option{-falign-commons}. ...@@ -1056,8 +1056,9 @@ off via @option{-Wno-align-commons}. See also @option{-falign-commons}.
@opindex @code{Wfunction-elimination} @opindex @code{Wfunction-elimination}
@cindex function elimination @cindex function elimination
@cindex warnings, function elimination @cindex warnings, function elimination
Warn if any calls to functions are eliminated by the optimizations Warn if any calls to impure functions are eliminated by the optimizations
enabled by the @option{-ffrontend-optimize} option. enabled by the @option{-ffrontend-optimize} option.
This option is implied by @option{-Wextra}.
@item -Wrealloc-lhs @item -Wrealloc-lhs
@opindex @code{Wrealloc-lhs} @opindex @code{Wrealloc-lhs}
......
...@@ -250,7 +250,7 @@ Fortran Var(flag_warn_frontend_loop_interchange) ...@@ -250,7 +250,7 @@ Fortran Var(flag_warn_frontend_loop_interchange)
Warn if loops have been interchanged. Warn if loops have been interchanged.
Wfunction-elimination Wfunction-elimination
Fortran Warning Var(warn_function_elimination) Fortran Warning Var(warn_function_elimination) LangEnabledBy(Fortran,Wextra)
Warn about function call elimination. Warn about function call elimination.
Wimplicit-interface Wimplicit-interface
......
...@@ -2941,8 +2941,8 @@ is_external_proc (gfc_symbol *sym) ...@@ -2941,8 +2941,8 @@ is_external_proc (gfc_symbol *sym)
static int static int
pure_stmt_function (gfc_expr *, gfc_symbol *); pure_stmt_function (gfc_expr *, gfc_symbol *);
static int int
pure_function (gfc_expr *e, const char **name) gfc_pure_function (gfc_expr *e, const char **name)
{ {
int pure; int pure;
gfc_component *comp; gfc_component *comp;
...@@ -2982,6 +2982,21 @@ pure_function (gfc_expr *e, const char **name) ...@@ -2982,6 +2982,21 @@ pure_function (gfc_expr *e, const char **name)
} }
/* 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 static bool
impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym, impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
int *f ATTRIBUTE_UNUSED) int *f ATTRIBUTE_UNUSED)
...@@ -2996,7 +3011,7 @@ impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym, ...@@ -2996,7 +3011,7 @@ impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
|| e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION) || e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
return false; 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) ...@@ -3012,7 +3027,7 @@ pure_stmt_function (gfc_expr *e, gfc_symbol *sym)
static bool check_pure_function (gfc_expr *e) static bool check_pure_function (gfc_expr *e)
{ {
const char *name = NULL; const char *name = NULL;
if (!pure_function (e, &name) && name) if (!gfc_pure_function (e, &name) && name)
{ {
if (forall_flag) if (forall_flag)
{ {
...@@ -3034,7 +3049,8 @@ static bool check_pure_function (gfc_expr *e) ...@@ -3034,7 +3049,8 @@ static bool check_pure_function (gfc_expr *e)
"within a PURE procedure", name, &e->where); "within a PURE procedure", name, &e->where);
return false; return false;
} }
gfc_unset_implicit_pure (NULL); if (!gfc_implicit_pure_function (e))
gfc_unset_implicit_pure (NULL);
} }
return true; return true;
} }
...@@ -3822,6 +3838,41 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop) ...@@ -3822,6 +3838,41 @@ 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 /* Resolve an operator expression node. This can involve replacing the
operation with a user defined function call. */ operation with a user defined function call. */
...@@ -3930,6 +3981,14 @@ resolve_operator (gfc_expr *e) ...@@ -3930,6 +3981,14 @@ resolve_operator (gfc_expr *e)
gfc_convert_type (op1, &e->ts, 2); gfc_convert_type (op1, &e->ts, 2);
else if (op2->ts.kind < e->ts.kind) else if (op2->ts.kind < e->ts.kind)
gfc_convert_type (op2, &e->ts, 2); 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; break;
} }
......
2018-07-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/85599
* gfortran.dg/function_optimize_5.f90: Add option
'-faggressive-function-elimination' and update dg-warning clauses.
* gfortran.dg/short_circuiting.f90: New test.
2018-07-18 Marek Polacek <polacek@redhat.com> 2018-07-18 Marek Polacek <polacek@redhat.com>
PR c++/86190 - bogus -Wsign-conversion warning PR c++/86190 - bogus -Wsign-conversion warning
......
! { dg-do compile } ! { dg-do compile }
! { dg-options "-ffrontend-optimize -finline-matmul-limit=0 -Wfunction-elimination" } ! { dg-options "-ffrontend-optimize -faggressive-function-elimination -finline-matmul-limit=0 -Wfunction-elimination" }
! Check the -ffrontend-optimize (in the absence of -O) and ! Check the -ffrontend-optimize (in the absence of -O) and
! -Wfunction-elimination options. ! -Wfunction-elimination options.
program main program main
...@@ -26,16 +26,16 @@ program main ...@@ -26,16 +26,16 @@ program main
data a /2., 3., 5., 7./ data a /2., 3., 5., 7./
data b /11., 13., 17., 23./ data b /11., 13., 17., 23./
write (unit=line, fmt='(4F7.2)') matmul(a,b) & ! { dg-warning "Removing call to function 'matmul'" } write (unit=line, fmt='(4F7.2)') matmul(a,b) &
& + matmul(a,b) & + matmul(a,b)
z = sin(x) + 2.0 + sin(x) ! { dg-warning "Removing call to function 'sin'" } z = sin(x) + 2.0 + sin(x)
print *,z print *,z
x = ext_func(a) + 23 + ext_func(a) x = ext_func(a) + 23 + ext_func(a) ! { dg-warning "Removing call to impure function" }
print *,d,x print *,d,x
z = element(x) + element(x) ! { dg-warning "Removing call to function 'element'" } z = element(x) + element(x)
print *,z print *,z
i = mypure(x) - mypure(x) ! { dg-warning "Removing call to function 'mypure'" } i = mypure(x) - mypure(x)
print *,i print *,i
z = elem_impure(x) - elem_impure(x) z = elem_impure(x) - elem_impure(x) ! { dg-warning "Removing call to impure function" }
print *,z print *,z
end program main end program main
! { dg-do compile }
! { dg-additional-options "-Wextra" }
!
! PR 85599: warn about short-circuiting of logical expressions for non-pure functions
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
module a
interface impl_pure_a
module procedure impl_pure_a1
end interface
contains
logical function impl_pure_a1()
impl_pure_a1 = .true.
end function
end module
program short_circuit
use a
logical :: flag
flag = .false.
flag = check() .and. flag
flag = flag .and. check() ! { dg-warning "might not be evaluated" }
flag = flag .and. pure_check()
flag = flag .and. impl_pure_1()
flag = flag .and. impl_pure_2()
flag = flag .and. impl_pure_a1()
flag = flag .and. impl_pure_a()
contains
logical function check()
integer, save :: i = 1
print *, "check", i
i = i + 1
check = .true.
end function
logical pure function pure_check()
pure_check = .true.
end function
logical function impl_pure_1()
impl_pure_1 = .true.
end function
logical function impl_pure_2()
impl_pure_2 = impl_pure_1()
end function
end
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