Hello world, the attached patch introduces the following changes:
If a logical .and. or .or. expression contains a reference to a function which is impure and which also does not behave like a pure function (i.e. does not have the implicit_pure attribute set), it emits a warning with -Wsurprising that the function might not be evaluated. (-Wsurprising is enabled by -Wall). It special cases the idiom if (associated(m) .and. m%t) which people appear to use. And, if there is an expression like func() .and. flag , it reverses the test as an optimization. The middle end should be capable of doing this, but apparently it doesn't, so the front end might as well do this. What it does not do is one part of PR 57160, i.e. warn against if (a /= 0 .and. 1/a > 5) which people who are used to C might also like to write. There is already quite some discussion in the PRs, especially 85599, where not all people were of the same opinion. Let us see where the discussion here leads us. Regression-tested (which found one bug in the testsuite). OK for trunk? Regards Thomas 2018-06-11 Thomas Koenig <tkoe...@gcc.gnu.org> PR fortran/57160 PR fortran/85599 * dump-parse-tree (show_attr): Add handling of implicit_pure. * resolve.c (impure_function_callback): New function. (resolve_operator): Call it vial gfc_expr_walker. Special-case if (associated(m) .and. m%t). If an .and. or .or. expression has a function or a non-function, exchange the operands. 2018-06-11 Thomas Koenig <tkoe...@gcc.gnu.org> PR fortran/57160 PR fortran/85599 * gfortran.dg/logical_evaluation_1.f90: New test. * gfortran.dg/alloc_comp_default_init_2.f90: Fix code which implicitly depends on short-circuiting.
Index: fortran/dump-parse-tree.c =================================================================== --- fortran/dump-parse-tree.c (Revision 261388) +++ fortran/dump-parse-tree.c (Arbeitskopie) @@ -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: fortran/resolve.c =================================================================== --- fortran/resolve.c (Revision 261388) +++ fortran/resolve.c (Arbeitskopie) @@ -3807,7 +3807,43 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop return gfc_closest_fuzzy_match (op, candidates); } +/* 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 && !pure_function (f, &name)) + { + /* This could still be a function without side effects, i.e. + implicit pure. Do not warn for that case. */ + if (f->symtree == NULL || f->symtree->n.sym == NULL + || !gfc_implicit_pure (f->symtree->n.sym)) + { + if (name) + gfc_warning (OPT_Wsurprising, "Impure function %qs at %L " + "might not be evaluated", name, &f->where); + else + gfc_warning (OPT_Wsurprising, "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. */ @@ -3910,6 +3946,8 @@ resolve_operator (gfc_expr *e) case INTRINSIC_NEQV: if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) { + bool dont_move = false; + e->ts.type = BT_LOGICAL; e->ts.kind = gfc_kind_max (op1, op2); if (op1->ts.kind < e->ts.kind) @@ -3916,6 +3954,53 @@ 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) + { + bool op1_f, op2_f; + + op1_f = false; + op2_f = false; + gfc_expr_walker (&op1, impure_function_callback, &op1_f); + gfc_expr_walker (&op2, impure_function_callback, &op2_f); + + /* Some people code which depends on the short-circuiting that + Fortran does not provide, such as + + if (associated(m) .and. m%t) then + + So, warn about this idiom. However, avoid breaking + it on purpose. */ + + if (op1->expr_type == EXPR_FUNCTION && op1->value.function.isym + && op1->value.function.isym->id == GFC_ISYM_ASSOCIATED) + { + gfc_expr *e = op1->value.function.actual->expr; + gfc_expr *en = op1->value.function.actual->next->expr; + if (en == NULL && gfc_check_dependency (e, op2, true)) + { + gfc_warning (OPT_Wsurprising, "%qs function call at %L does " + "not guard expression at %L", "ASSOCIATED", + &op1->where, &op2->where); + dont_move = true; + } + } + + /* A bit of optimization: Transfer if (f(x) .and. flag) + into if (flag .and. f(x)), to save evaluation of a + function. The middle end should be capable of doing + this with a TRUTH_AND_EXPR, but it currently does not do + so. See PR 85599. */ + + if (!dont_move && op1_f && !op2_f) + { + e->value.op.op1 = op2; + e->value.op.op2 = op1; + op1 = e->value.op.op1; + op2 = e->value.op.op2; + } + } + break; } Index: testsuite/gfortran.dg/alloc_comp_default_init_2.f90 =================================================================== --- testsuite/gfortran.dg/alloc_comp_default_init_2.f90 (Revision 261388) +++ testsuite/gfortran.dg/alloc_comp_default_init_2.f90 (Arbeitskopie) @@ -11,7 +11,8 @@ program testprog integer, save :: callnb = 0 type(t_type) :: this allocate ( this % chars ( 4)) - if (.not.recursivefunc (this) .or. (callnb .ne. 10)) STOP 1 + if (.not.recursivefunc (this)) STOP 1 + if (callnb .ne. 10) STOP 2 contains recursive function recursivefunc ( this ) result ( match ) type(t_type), intent(in) :: this
! { dg-do compile } ! { dg-additional-options "-Wsurprising -fdump-tree-original" } ! PR 85599 - check warning that impure function calls might be removed, ! and that logical expressions involving .and. and .or. will be ! reordered. MODULE M1 TYPE T1 LOGICAL :: T=.TRUE. END TYPE T1 CONTAINS SUBROUTINE S1(m) TYPE(T1), POINTER :: m IF (ASSOCIATED(m) .AND. m%T) THEN ! { dg-warning "does not guard expression" } WRITE(6,*) "X" ENDIF END SUBROUTINE END MODULE module x logical :: flag = .true. integer :: count = 0 contains pure function f() logical :: f f = .true. end function f function g() logical :: g g = .false. end function g real function h() h = 1.2 count = count + 1 end function h end module x program main use x print *, g() .and. f() ! No warning, because g() follows all the rules of a pure function print *, f() .and. flag print *, h() > 1.0 .and. flag ! { dg-warning "might not be evaluated" } print *, h() < 1.0 .or. flag ! { dg-warning "might not be evaluated" } end program main ! { dg-final { scan-tree-dump-times "flag &&" 2 "original" } } ! { dg-final { scan-tree-dump-times "flag \\|\\|" 1 "original" } }