Hi Janus,
I happen to hold the opinion that optimizing out a call to a pure function may be reasonable if it does not influence the result of an expression, but optimizing out an effectively impure function (i.e. one with side effects) is not a good idea at any time, since such an 'optimization' can drastically change the program flow and all numerical results of a piece of code.
Well, I am of a different opinion, and so is the Fortran standard. I think the compiler should strive to, in that order, - conform to the language standard - generate fast programs - warn about features which may trip the user In my patch, I have tried to do all three things at the same time, and after this discussion, I still think that this is the right path to follow. So, here is an update on the patch, which also covers ALLOCATED. Regression-tested. OK? Thomas
! { 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 TYPE(T1), ALLOCATABLE :: x IF (ASSOCIATED(m) .AND. m%T) THEN ! { dg-warning "does not guard expression" } WRITE(6,*) "X" ENDIF IF (ALLOCATED(x) .AND. x%T) THEN ! { dg-warning "does not guard expression" } WRITE(6,*) "" 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" } }
Index: dump-parse-tree.c =================================================================== --- dump-parse-tree.c (Revision 261388) +++ 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: resolve.c =================================================================== --- resolve.c (Revision 261388) +++ 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, "Function %qs at %L " + "might not be evaluated", name, &f->where); + else + gfc_warning (OPT_Wsurprising, "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,67 @@ 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) + { + gfc_expr *e; + bool warn = false; + gfc_isym_id id; + + id = op1->value.function.isym->id; + if (id == GFC_ISYM_ASSOCIATED) + { + e = op1->value.function.actual->expr; + warn = op1->value.function.actual->next->expr == NULL; + } + else if (id == GFC_ISYM_ALLOCATED) + { + e = op1->value.function.actual->expr; + warn = true; + } + + if (warn && gfc_check_dependency (e, op2, true)) + { + gfc_warning (OPT_Wsurprising, "%qs function call at " + "%L does not guard expression at %L", + op1->value.function.isym->name, + &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; }