From patchwork Tue Jun 28 19:01:14 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 102445 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 5EADAB6F67 for ; Wed, 29 Jun 2011 05:01:44 +1000 (EST) Received: (qmail 4224 invoked by alias); 28 Jun 2011 19:01:42 -0000 Received: (qmail 4206 invoked by uid 22791); 28 Jun 2011 19:01:41 -0000 X-SWARE-Spam-Status: No, hits=-1.0 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, T_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; Tue, 28 Jun 2011 19:01:24 +0000 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 3CB06124FA; Tue, 28 Jun 2011 21:01:23 +0200 (CEST) Received: from [192.168.0.197] (xdsl-78-35-180-190.netcologne.de [78.35.180.190]) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA id C324A86AC3; Tue, 28 Jun 2011 21:01:20 +0200 (CEST) Message-ID: <4E0A24FA.4040303@netcologne.de> Date: Tue, 28 Jun 2011 21:01:14 +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: Jerry DeLisle CC: "fortran@gcc.gnu.org" , gcc-patches Subject: Re: [patch, fortran] Fix PR 49479, reshape with optional arg References: <4E0901A7.90905@netcologne.de> <4E0935A5.2070209@charter.net> In-Reply-To: <4E0935A5.2070209@charter.net> 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 Hi Jerry, > On 06/27/2011 03:18 PM, Thomas Koenig wrote: >> Hello world, >> >> the attached patch fixes PR 49479, a regression for 4.7 and 4.6. Test >> case was supplied by Joost, the approach to the patch was suggested by >> Tobias in comment#4 of the PR. The patch certainly looks safe enough. >> >> Regression-tested. OK for trunk and, after a couple of days, for 4.6? >> >> Thomas >> > > OK, After your approval, I realized that I had forgotten the generic reshape. I added that as obvious. Here is what I committed, revision 175594. Regards Thomas 2011-06-28 Thomas Koenig PR fortran/49479 * m4/reshape.m4: If source allocation is smaller than one, set it to one. * intrinsics/reshape_generic.c: Likewise. * generated/reshape_r16.c: Regenerated. * generated/reshape_c4.c: Regenerated. * generated/reshape_c16.c: Regenerated. * generated/reshape_c8.c: Regenerated. * generated/reshape_r4.c: Regenerated. * generated/reshape_i4.c: Regenerated. * generated/reshape_r10.c: Regenerated. * generated/reshape_r8.c: Regenerated. * generated/reshape_c10.c: Regenerated. * generated/reshape_i8.c: Regenerated. * generated/reshape_i16.c: Regenerated. 2011-06-28 Thomas Koenig PR fortran/49479 * gfortran.dg/reshape_zerosize_3.f90: New test. ! { dg-do run } ! PR 49479 - this used not to print anything. ! Test case by Joost VandeVondele. MODULE M1 IMPLICIT NONE type foo character(len=5) :: x end type foo CONTAINS SUBROUTINE S1(data) INTEGER, DIMENSION(:), INTENT(IN), & OPTIONAL :: DATA character(20) :: line IF (.not. PRESENT(data)) call abort write (unit=line,fmt='(I5)') size(data) if (line /= ' 0 ') call abort END SUBROUTINE S1 subroutine s_type(data) type(foo), dimension(:), intent(in), optional :: data character(20) :: line IF (.not. PRESENT(data)) call abort write (unit=line,fmt='(I5)') size(data) if (line /= ' 0 ') call abort end subroutine s_type SUBROUTINE S2(N) INTEGER :: N INTEGER, ALLOCATABLE, DIMENSION(:, :) :: blki type(foo), allocatable, dimension(:, :) :: bar ALLOCATE(blki(3,N)) allocate (bar(3,n)) blki=0 CALL S1(RESHAPE(blki,(/3*N/))) call s_type(reshape(bar, (/3*N/))) END SUBROUTINE S2 END MODULE M1 USE M1 CALL S2(0) END ! { dg-final { cleanup-modules "m1" } } Index: m4/reshape.m4 =================================================================== --- m4/reshape.m4 (Revision 175593) +++ m4/reshape.m4 (Arbeitskopie) @@ -101,6 +101,8 @@ if (ret->data == NULL) { + index_type alloc_size; + rs = 1; for (n = 0; n < rdim; n++) { @@ -111,7 +113,13 @@ rs *= rex; } ret->offset = 0; - ret->data = internal_malloc_size ( rs * sizeof ('rtype_name`)); + + if (unlikely (rs < 1)) + alloc_size = 1; + else + alloc_size = rs * sizeof ('rtype_name`); + + ret->data = internal_malloc_size (alloc_size); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } Index: intrinsics/reshape_generic.c =================================================================== --- intrinsics/reshape_generic.c (Revision 175593) +++ intrinsics/reshape_generic.c (Arbeitskopie) @@ -85,6 +85,8 @@ if (ret->data == NULL) { + index_type alloc_size; + rs = 1; for (n = 0; n < rdim; n++) { @@ -95,7 +97,14 @@ rs *= rex; } ret->offset = 0; - ret->data = internal_malloc_size ( rs * size ); + + if (unlikely (rs < 1)) + alloc_size = 1; + else + alloc_size = rs * size; + + ret->data = internal_malloc_size (alloc_size); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; }