From patchwork Mon Jun 11 19:22:27 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 927867 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-479487-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=netcologne.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NN+41HMI"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 414NFf4JXkz9rvt for ; Tue, 12 Jun 2018 05:22:46 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=sX5NHax1I1UCrXpkqqTm1oEzD4raC6K+7e4CvGbNxHY1tV7lWh 5HL7zlJMsG87saZ0oVMiPXO+2na8S8StrPH+rCHzscKtxasIc6syG7MOi76lPoVH XOBLuupU7mSkv+9fNyMAWstruDM4ZP7byE1tQnH2H0PWnT4Is6eP+feAU= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=h8Ggch0F2CDpsv9FE+6lfcKPcxo=; b=NN+41HMIWRbgGbLHbhFP mYrOcfBdgDnrgjXjsU/EJ8YiVrqHvg+WUbfcQQJIZFlZf0JRxB2xyixSEf1uugRj UJvytkujbR6sDAUm6pwJEUqEGnQsKnQqdMa/b4F90z6kLHBtNK5M0iDJ+GY8mn6x GPRqbVK+Ms+matjkOxwC+Gs= Received: (qmail 89742 invoked by alias); 11 Jun 2018 19:22:34 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 89718 invoked by uid 89); 11 Jun 2018 19:22:34 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-9.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=warned, apparently, exchange, involving X-Spam-User: qpsmtpd, 2 recipients X-HELO: cc-smtpout2.netcologne.de Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 11 Jun 2018 19:22:31 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 164CE127EE; Mon, 11 Jun 2018 21:22:29 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id 099C811DEC; Mon, 11 Jun 2018 21:22:29 +0200 (CEST) Received: from [78.35.152.204] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.1.9) (envelope-from ) id 5b1ecbf5-029d-7f0000012729-7f000001a38b-1 for ; Mon, 11 Jun 2018 21:22:29 +0200 Received: from [192.168.178.68] (xdsl-78-35-152-204.netcologne.de [78.35.152.204]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Mon, 11 Jun 2018 21:22:27 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Handling of .and. and .or. expressions Message-ID: Date: Mon, 11 Jun 2018 21:22:27 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.8.0 MIME-Version: 1.0 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 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 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