From patchwork Sat Sep 10 09:23:22 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 114154 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 2987FB7150 for ; Sat, 10 Sep 2011 19:24:05 +1000 (EST) Received: (qmail 2563 invoked by alias); 10 Sep 2011 09:23:59 -0000 Received: (qmail 2547 invoked by uid 22791); 10 Sep 2011 09:23:57 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 10 Sep 2011 09:23:26 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 6628A1235D; Sat, 10 Sep 2011 11:23:24 +0200 (CEST) Received: from [192.168.0.197] (xdsl-84-44-211-108.netcologne.de [84.44.211.108]) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id 2FA6711E89; Sat, 10 Sep 2011 11:23:23 +0200 (CEST) Message-ID: <4E6B2C8A.9090706@netcologne.de> Date: Sat, 10 Sep 2011 11:23:22 +0200 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.17) Gecko/20110414 SUSE/3.1.10 Thunderbird/3.1.10 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] Fix PR 50327, regression in DO WHILE 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 Hello world, the attached patch fixes the PR by transforming DO WHILE (condition) ... END DO into the equvialent DO WHILE(.true.) IF (.not. condition) exit ... END DO before applying common function elimination. Otherwise, the temporary variables are created in the outer scope, and the condition never changes. Thanks to Tobias for finding the bug and forthe analysis in the PR. Regression-tested. OK for trunk? Thomas 2011-09-10 Thomas Koenig PR fortran/50327 * frontend-passes.c (dummy_expr_callback): New function. (convert_do_while): New function. (optimize_namespace): Call code walker to convert do while loops. 2011-09-10 Thomas Koenig PR fortran/50327 * gfortran.dg/do_while_1.f90: New test. ! { dg-do run } ! PR 50327 - this used to cause an endless loop because ! of wrong fron-end optimization. program main real :: tmp tmp = 0. do while (abs(tmp) < 10. .and. abs(tmp) < 20.) tmp = tmp + 1. end do end program main Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 178139) +++ frontend-passes.c (Arbeitskopie) @@ -407,6 +407,85 @@ cfe_code (gfc_code **c, int *walk_subtrees ATTRIBU return 0; } +/* Dummy function for expression call back, for use when we + really don't want to do any walking. */ + +static int +dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED, int *walk_subtrees, + void *data ATTRIBUTE_UNUSED) +{ + *walk_subtrees = 0; + return 0; +} + +/* Code callback function for converting + do while(a) + end do + into the equivalent + do + if (.not. a) exit + end do + This is because common function elimination would otherwise place the + temporary variables outside the loop. */ + +static int +convert_do_while (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_code *co = *c; + gfc_code *c_if1, *c_if2, *c_exit; + gfc_code *loopblock; + gfc_expr *e_not, *e_cond; + + if (co->op != EXEC_DO_WHILE) + return 0; + + if (co->expr1 == NULL || co->expr1->expr_type == EXPR_CONSTANT) + return 0; + + e_cond = co->expr1; + + /* Generate the condition of the if statement, which is .not. the original + statement. */ + e_not = gfc_get_expr (); + e_not->ts = e_cond->ts; + e_not->where = e_cond->where; + e_not->expr_type = EXPR_OP; + e_not->value.op.op = INTRINSIC_NOT; + e_not->value.op.op1 = e_cond; + + /* Generate the EXIT statement. */ + c_exit = XCNEW (gfc_code); + c_exit->op = EXEC_EXIT; + c_exit->ext.which_construct = co; + c_exit->loc = co->loc; + + /* Generate the IF statement. */ + c_if2 = XCNEW (gfc_code); + c_if2->op = EXEC_IF; + c_if2->expr1 = e_not; + c_if2->next = c_exit; + c_if2->loc = co->loc; + + /* ... plus the one to chain it to. */ + c_if1 = XCNEW (gfc_code); + c_if1->op = EXEC_IF; + c_if1->block = c_if2; + c_if1->loc = co->loc; + + /* Make the DO WHILE loop into a DO block by replacing the condition + with a true constant. */ + co->expr1 = gfc_get_logical_expr (gfc_default_integer_kind, &co->loc, true); + + /* Hang the generated if statement into the loop body. */ + + loopblock = co->block->next; + co->block->next = c_if1; + c_if1->next = loopblock; + + return 0; +} + /* Optimize a namespace, including all contained namespaces. */ static void @@ -415,6 +494,7 @@ optimize_namespace (gfc_namespace *ns) current_ns = ns; + gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL); gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL); gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL);