From patchwork Fri Jun 21 15:14:32 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 253254 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 0749E2C01FC for ; Sat, 22 Jun 2013 01:14:52 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=CtkLGaHpuU9o3MnqZKKjcKMROokXZ40lrSyFIZVUfpt4zd 7g/hv0mAZJGjEQghL93WJnyckHRMPVH+GqOFtZnnq5zkOk7ZW4mw/0gn2OQZXC4n fbqDwRP6YR37kRm+nZ1qx/tGwgHuT2Fafyiay0gfDI8vnjyGYl6lMqHA8I5hY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=TlaPbV40XOMBZ/NZbLuc4ZOPYMA=; b=nc2V8bUCaAbIZPH16iSE gElyH8N4Ivn3I5FJLyDZ0AoMkNtKjmas1Ar/zixuHcb213yyjxJvxsU+K9gTMiln nX2A45jHLj96/EgKnZzJp6lJMA4FdYZ7gW0dyesCNnildUbwap4FCM7E9zFvDlER BplqPYqW5e+keJiLmDI/WtY= Received: (qmail 16382 invoked by alias); 21 Jun 2013 15:14:41 -0000 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 Received: (qmail 16360 invoked by uid 89); 21 Jun 2013 15:14:40 -0000 X-Spam-SWARE-Status: No, score=-2.2 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Fri, 21 Jun 2013 15:14:38 +0000 Received: from archimedes.net-b.de (port-92-195-115-81.dynamic.qsc.de [92.195.115.81]) by mx01.qsc.de (Postfix) with ESMTP id 2E23C3C6EA; Fri, 21 Jun 2013 17:14:32 +0200 (CEST) Message-ID: <51C46DD8.2010206@net-b.de> Date: Fri, 21 Jun 2013 17:14:32 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] Realloc on assignment: Allocate at least a byte X-Virus-Found: No In order to ensure that "ALLOCATED(var)" works, we have to allocate at least one byte. While malloc(0) is permitted, it is system depended whether it returns NULL or a unique non-NULL pointer. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-06-21 Tobias Burnus * trans-array.c (gfc_alloc_allocatable_for_assignment): Allocate at least one byte. * trans-expr.c (alloc_scalar_allocatable_for_assignment): Ditto. 2013-06-21 Tobias Burnus * gfortran.dg/realloc_on_assign_18.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a4321cc..24e5aa3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8209,6 +8209,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_array_index_type, tmp, size2); size2 = fold_convert (size_type_node, size2); + size2 = fold_build2_loc (input_location, MAX_EXPR, size_type_node, + size2, size_one_node); size2 = gfc_evaluate_now (size2, &fblock); /* Realloc expression. Note that the scalarizer uses desc.data diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index bd8886c..56dc766 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -7574,6 +7574,9 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, size_in_bytes = size; } + size_in_bytes = fold_build2_loc (input_location, MAX_EXPR, size_type_node, + size_in_bytes, size_one_node); + if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp) { tmp = build_call_expr_loc (input_location, --- /dev/null 2013-06-21 09:21:05.672079164 +0200 +++ gcc/gcc/testsuite/gfortran.dg/realloc_on_assign_18.f90 2013-06-21 15:55:44.729537597 +0200 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Ensure that for zero-sized array, nonzero memory is allocated +! +type t +end type t + +type(t), allocatable :: x, y(:) + +x = t() +y = [ t :: ] + +if (.not. allocated (x)) call abort () +if (.not. allocated (y)) call abort () +end + +! { dg-final { scan-tree-dump "x = \\(struct t .\\) __builtin_malloc \\(1\\);" "original" } } +! { dg-final { scan-tree-dump "y.data = \\(void . restrict\\) __builtin_malloc \\(1\\);" "original" } } +! { dg-final { cleanup-tree-dump "original" } }