From patchwork Sun Jan 29 10:16:16 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 138434 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 4D5C61007D1 for ; Sun, 29 Jan 2012 21:16:41 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1328437002; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=e/5jfZg bsnmE9MXOpB84GHpW+j0=; b=uQiTVcmH0EN1e7ul9z1o9w31AfSmBti5wlaFEw5 QmymMCBWn6Fd/pmBHmkQajPp1lW4vPX/abRpaABvgWWjuWJSb5DhEDbnVKJpc490 zdcbD+b13ZNFBT19Q1z+jFSjC+1+CBWWMc18NRuCiugNsWiUyJQe3DSJQ6vxevBZ a3Z0= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=Bsb5r8tTgOfbltq+qBQCAZFtHeNA8J5aVhS5JnfQod3q7Lez7rKrZvbnQ4XLM9 SAttcRosRUyDti/jhXC0pnTLOJsmnQytaJNuxf4RxwoYnxMuDVqTD0+bN9I3qdxe UcWuI+qpmEFWBQk9NO1MwZSCA/7h5WSmOU/pg1Uh+EUqE=; Received: (qmail 2695 invoked by alias); 29 Jan 2012 10:16:34 -0000 Received: (qmail 2677 invoked by uid 22791); 29 Jan 2012 10:16:33 -0000 X-SWARE-Spam-Status: No, hits=-1.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_TM, T_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, 29 Jan 2012 10:16:19 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id E007D1310C; Sun, 29 Jan 2012 11:16:17 +0100 (CET) Received: from [192.168.0.109] (xdsl-78-35-155-159.netcologne.de [78.35.155.159]) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id B0DA011D8E; Sun, 29 Jan 2012 11:16:16 +0100 (CET) Message-ID: <4F251C70.7090802@netcologne.de> Date: Sun, 29 Jan 2012 11:16:16 +0100 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 51858, wrong-code regression with function elimination 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 converting if (foo) then ... else if (bar) then ... end if to if (foo) then else if (bar) then end if end if so inserting a block for temporary variables around the converted if statement works. OK for trunk? Thomas 2012-01-29 Thomas König PR fortran/51858 * frontend-passes.c (convert_elseif): New function. (optimize_namespace): Call it. 2012-01-29 Thomas König PR fortran/51858 * gfortran.dg/function_optimize_10.f90: New test. ! { do-do run } ! PR 51858 - this used to generate wrong code. ! Original test case by Don Simons. program main implicit none logical :: test1_ok logical :: test2_ok character(len=1):: charq test1_ok = .true. test2_ok = .false. charq = 'c' if (charq .eq. ' ') then test1_ok = .false. else if ((my_ichar(charq).ge.97 .and. my_ichar(charq).le.103)) then test2_OK = .true. end if if ((.not. test1_ok) .or. (.not. test2_ok)) call abort contains pure function my_ichar(c) integer :: my_ichar character(len=1), intent(in) :: c my_ichar = ichar(c) end function my_ichar end program main Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 183449) +++ frontend-passes.c (Arbeitskopie) @@ -509,6 +509,63 @@ convert_do_while (gfc_code **c, int *walk_subtrees return 0; } +/* Code callback function for converting + if (a) then + ... + else if (b) then + end if + + into + if (a) then + else + if (b) then + end if + end if + + because otherwise common function elimination would place the BLOCKs + into the wrong place. */ + +static int +convert_elseif (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_code *co = *c; + gfc_code *c_if1, *c_if2, *else_stmt; + + if (co->op != EXEC_IF) + return 0; + + /* This loop starts out with the first ELSE statement. */ + for (else_stmt = co->block->block; else_stmt != NULL; + else_stmt = else_stmt->block) + { + /* If there is no condition, we're set. */ + if (else_stmt->expr1 == NULL) + break; + + /* Generate the new IF statement. */ + c_if2 = XCNEW (gfc_code); + c_if2->op = EXEC_IF; + c_if2->expr1 = else_stmt->expr1; + c_if2->next = else_stmt->next; + c_if2->loc = else_stmt->loc; + c_if2->block = else_stmt->block; + + /* ... 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 = else_stmt->loc; + + /* Insert the new IF after the ELSE. */ + else_stmt->expr1 = NULL; + else_stmt->next = c_if1; + else_stmt->block = NULL; + else_stmt->next = c_if1; + } + /* Don't walk subtrees. */ + return 1; +} /* Optimize a namespace, including all contained namespaces. */ static void @@ -520,6 +577,7 @@ optimize_namespace (gfc_namespace *ns) in_omp_workshare = false; gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL); + gfc_code_walker (&ns->code, convert_elseif, 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);