From patchwork Fri Mar 15 08:07:57 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 227872 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 C5E512C00CF for ; Fri, 15 Mar 2013 19:08:29 +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=1363939711; 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=RIegBsd QvG+JplRjPXLo9U4Dk4o=; b=T4ygDbXbAYxPqBXUqUDMg/Zig7qnVADAm+ONf7E nfnnAgCAMy/QP284TNSnGGIdNnuuKYN3/6NlJB9B5zr98NMMIIxdR4mGxmcfxheg 54MYN4s2He7cKgiJvyuuDfwen8lqBo1L/8AwJdLqMV/0yLkBlrGn01y1ac9KGWf0 RuNM= 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=jBde9kAmv5tEhRLCWxyRoef4piJ3BFoE6NAtIySx4QnDsJDUoLR8yjgCoHvbxo Jgtb0dHLO3oPn+ztlyZM1bWfxDCbkOwCjzKRm/H0MM2GsoEl3jk5xIhBoRRKQ2cd SRE0g9TKUZ+DcC+/rEFrYaSx5yopJ5tzueD3fi7A5gnyY=; Received: (qmail 17627 invoked by alias); 15 Mar 2013 08:08:15 -0000 Received: (qmail 17581 invoked by uid 22791); 15 Mar 2013 08:08:09 -0000 X-SWARE-Spam-Status: No, hits=-2.2 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_FC 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; Fri, 15 Mar 2013 08:08:02 +0000 Received: from archimedes.net-b.de (port-92-195-57-206.dynamic.qsc.de [92.195.57.206]) by mx02.qsc.de (Postfix) with ESMTP id 20C212795A; Fri, 15 Mar 2013 09:07:57 +0100 (CET) Message-ID: <5142D6DD.2090902@net-b.de> Date: Fri, 15 Mar 2013 09:07:57 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130215 Thunderbird/17.0.3 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR56615 - Wrong-code with TRANSFER of noncontiguous arrays 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 The issue is a regression which exists since GCC 4.4. The fix is rather obvious (see also PR). Build and regtested on x86-64-gnu-linux. OK for the trunk and the two maintained branches, 4.6 and 4.7? Tobias 2013-03-15 Tobias Burnus PR fortran/56615 * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays if they are not simply contiguous. 2013-03-15 Tobias Burnus PR fortran/56615 * gfortran.dg/transfer_intrinsic_5.f90: New. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 83e3acf..7905503 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5435,9 +5435,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) source = gfc_conv_descriptor_data_get (argse.expr); source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); - /* Repack the source if not a full variable array. */ - if (arg->expr->expr_type == EXPR_VARIABLE - && arg->expr->ref->u.ar.type != AR_FULL) + /* Repack the source if not simply contiguous. */ + if (!gfc_is_simply_contiguous (arg->expr, false)) { tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); diff --git a/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 new file mode 100644 index 0000000..47be585 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 @@ -0,0 +1,50 @@ +! { dg-do run } +! +! PR fortran/56615 +! +! Contributed by Harald Anlauf +! +! +program gfcbug + implicit none + integer, parameter :: n = 8 + integer :: i + character(len=1), dimension(n) :: a, b + character(len=n) :: s, t + character(len=n/2) :: u + + do i = 1, n + a(i) = achar (i-1 + iachar("a")) + end do +! print *, "# Forward:" +! print *, "a=", a + s = transfer (a, s) +! print *, "s=", s + call cmp (a, s) +! print *, " stride = +2:" + do i = 1, n/2 + u(i:i) = a(2*i-1) + end do +! print *, "u=", u + call cmp (a(1:n:2), u) +! print * +! print *, "# Backward:" + b = a(n:1:-1) +! print *, "b=", b + t = transfer (b, t) +! print *, "t=", t + call cmp (b, t) +! print *, " stride = -1:" + call cmp (a(n:1:-1), t) +contains + subroutine cmp (b, s) + character(len=1), dimension(:), intent(in) :: b + character(len=*), intent(in) :: s + character(len=size(b)) :: c + c = transfer (b, c) + if (c /= s) then + print *, "c=", c, " ", merge (" ok","BUG!", c == s) + call abort () + end if + end subroutine cmp +end program gfcbug