From patchwork Mon Sep 17 17:34:12 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 184515 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 B168A2C0083 for ; Tue, 18 Sep 2012 03:34:38 +1000 (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=1348508079; h=Comment: DomainKey-Signature: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=6oFV0iQ Y7Fw1/dTJ0a/xRVOxEhw=; b=q6eTyc6LXPbfRjBZ6Z5BRnW6VpJ364FKqkRvvwt /+sYmUfp8apYSDrHwmvfJuyAvEWdhaHoOE1XnRkJkh/T+8jEX3CW5UlK7KeR3BeV DF8HmuWv3DrQaplv6mIwZFXSvmj7gmtLKqt7yU/fTMc+n5SEyHKYfFfhIQzqRGGX mbzc= 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: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=l7JbyQVngaSUHdN5b7xj2LZFa9segEhhPcyIJuhpy03bHEfamYfVEajEAKJEIj jUOBOn1ys6pGIfVe0s+yoqm4dSUW1APUY89pl0sboB1gPnexQE3oAGTlJ0rk6O6A A81joRHIoz3sXy4+uf3sESOjof6NJX+hGjQTGXvX/qxOY=; Received: (qmail 23996 invoked by alias); 17 Sep 2012 17:34:31 -0000 Received: (qmail 23855 invoked by uid 22791); 17 Sep 2012 17:34:29 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 17 Sep 2012 17:34:14 +0000 Received: from [192.168.178.22] (port-92-204-67-8.dynamic.qsc.de [92.204.67.8]) by mx02.qsc.de (Postfix) with ESMTP id 6600127C0F; Mon, 17 Sep 2012 19:34:12 +0200 (CEST) Message-ID: <50575F14.7020904@net-b.de> Date: Mon, 17 Sep 2012 19:34:12 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:15.0) Gecko/20120825 Thunderbird/15.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR54608 - fix SCAN/VERIFY simplification 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 gfortran shouldn't simplify SCAN/VERIFY if the BACK= argument is present but not a constant. Build and regtested on x86-64-linux. OK for the trunk? Tobias 2012-09-17 Tobias Burnus PR fortran/54608 * simplify.c (gfc_simplify_scan, gfc_simplify_verify): Fix handling of BACK=variable. 2012-09-17 Tobias Burnus PR fortran/54608 * gfortran.dg/scan_2.f90 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 5aa2704..1c9dff2 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -5247,7 +5247,8 @@ gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind) if (k == -1) return &gfc_bad_expr; - if (e->expr_type != EXPR_CONSTANT || c->expr_type != EXPR_CONSTANT) + if (e->expr_type != EXPR_CONSTANT || c->expr_type != EXPR_CONSTANT + || ( b != NULL && b->expr_type != EXPR_CONSTANT)) return NULL; if (b != NULL && b->value.logical != 0) @@ -6335,7 +6336,8 @@ gfc_simplify_verify (gfc_expr *s, gfc_expr *set, gfc_expr *b, gfc_expr *kind) if (k == -1) return &gfc_bad_expr; - if (s->expr_type != EXPR_CONSTANT || set->expr_type != EXPR_CONSTANT) + if (s->expr_type != EXPR_CONSTANT || set->expr_type != EXPR_CONSTANT + || ( b != NULL && b->expr_type != EXPR_CONSTANT)) return NULL; if (b != NULL && b->value.logical != 0) --- /dev/null 2012-09-17 07:46:24.707708299 +0200 +++ gcc/gcc/testsuite/gfortran.dg/scan_2.f90 2012-09-17 18:10:31.000000000 +0200 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/54608 +! +! Contributed by James Van Buskirk +! +module m1 + implicit none + contains + subroutine s1(A) + logical A + integer iscan, iverify + character(7), parameter :: tf(2) = ['.FALSE.','.TRUE. '] + + iscan = scan('AA','A',back=A) + iverify = verify('xx','A',back=A) + if (iscan /= 2 .or. iverify /= 2) call abort () + print *, iverify, iscan +! write(*,'(a)') 'SCAN test: A = '//trim(tf(iscan)) ! should print true +! write(*,'(a)') 'VERIFY test: A = '//trim(tf(iverify)) ! should print true + end subroutine s1 +end module m1 + +program p1 + use m1 + implicit none + logical B + + call s1(.TRUE.) +end program p1 + +! { dg-final { scan-tree-dump-times "iscan = _gfortran_string_scan \\(2," 1 "original" } } +! { dg-final { scan-tree-dump-times "iverify = _gfortran_string_verify \\(2," 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } }