From patchwork Sun Oct 9 17:52:08 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 118606 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 0E80BB6F99 for ; Mon, 10 Oct 2011 04:52:33 +1100 (EST) Received: (qmail 25046 invoked by alias); 9 Oct 2011 17:52:29 -0000 Received: (qmail 25030 invoked by uid 22791); 9 Oct 2011 17:52:29 -0000 X-SWARE-Spam-Status: No, hits=-1.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout1.netcologne.de (HELO cc-smtpout1.netcologne.de) (89.1.8.211) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 09 Oct 2011 17:52:12 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 894AE1273D; Sun, 9 Oct 2011 19:52:10 +0200 (CEST) Received: from [192.168.0.105] (xdsl-78-35-175-101.netcologne.de [78.35.175.101]) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA id 5A6C511DB4; Sun, 9 Oct 2011 19:52:09 +0200 (CEST) Message-ID: <4E91DF48.5010704@netcologne.de> Date: Sun, 09 Oct 2011 19:52:08 +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 50564 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 removing common function elimination in FORALL statements. In the course of fixing this PR, I had originally fixed the ICE only to find that the transformation (where f is a function) forall (i=1:2) a(i) = f(i) + f(i) end forall to forall (i=1:2) tmp = f(i) a(i) = tmp end forall did the Wrong Thing. Oh well... Regression-tested. OK for tunk? Thomas 2011-10-09 Thomas Koenig PR fortran/50564 * frontend-passes (forall_level): New variable. (cfe_register_funcs): Don't register functions if we are within a forall loop. (optimize_namespace): Set forall_level to 0 before entry. (gfc_code_walker): Increase/decrease forall_level. 2011-10-09 Thomas Koenig PR fortran/50564 * gfortran.dg/forall_15.f90: New test case. ! { dg-do run } ! { dg-options "-ffrontend-optimize -fdump-tree-original" } ! PR 50564 - this used to ICE with front end optimization. ! Original test case by Andrew Benson. program test implicit none double precision, dimension(2) :: timeSteps, control integer :: iTime double precision :: ratio double precision :: a ratio = 0.7d0 control(1) = ratio**(dble(1)-0.5d0)-ratio**(dble(1)-1.5d0) control(2) = ratio**(dble(2)-0.5d0)-ratio**(dble(2)-1.5d0) forall(iTime=1:2) timeSteps(iTime)=ratio**(dble(iTime)-0.5d0)-ratio**(dble(iTime)-1.5d0) end forall if (any(abs(timesteps - control) > 1d-10)) call abort ! Make sure we still do the front-end optimization after a forall a = cos(ratio)*cos(ratio) + sin(ratio)*sin(ratio) if (abs(a-1.d0) > 1d-10) call abort end program test ! { dg-final { scan-tree-dump-times "__builtin_cos" 1 "original" } } ! { dg-final { scan-tree-dump-times "__builtin_sin" 1 "original" } } ! { dg-final { cleanup-tree-dump "original" } } Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 179709) +++ frontend-passes.c (Arbeitskopie) @@ -62,6 +62,10 @@ static gfc_code *inserted_block, **changed_stateme gfc_namespace *current_ns; +/* If we are within any forall loop. */ + +static int forall_level; + /* Entry point - run all passes for a namespace. So far, only an optimization pass is run. */ @@ -165,6 +169,12 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtre || (*e)->ts.u.cl->length->expr_type != EXPR_CONSTANT)) return 0; + /* We don't do function elimination within FORALL statements, it can + lead to wrong-code in certain circumstances. */ + + if (forall_level > 0) + return 0; + /* If we don't know the shape at compile time, we create an allocatable temporary variable to hold the intermediate result, but only if allocation on assignment is active. */ @@ -493,6 +503,7 @@ optimize_namespace (gfc_namespace *ns) { current_ns = ns; + forall_level = 0; gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL); gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL); @@ -1193,6 +1204,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code WALK_SUBEXPR (fa->end); WALK_SUBEXPR (fa->stride); } + forall_level ++; break; } @@ -1335,6 +1347,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code WALK_SUBEXPR (b->expr2); WALK_SUBCODE (b->next); } + + if (co->op == EXEC_FORALL || co->op == EXEC_DO_CONCURRENT) + forall_level --; + } } return 0;