From patchwork Mon Oct 25 22:24:00 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 69175 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 405A0B7043 for ; Tue, 26 Oct 2010 16:06:34 +1100 (EST) Received: (qmail 3782 invoked by alias); 26 Oct 2010 05:06:32 -0000 Received: (qmail 3762 invoked by uid 22791); 26 Oct 2010 05:06:31 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (140.186.70.92) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 26 Oct 2010 05:06:26 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PAVSy-00037s-Oq for gcc-patches@gcc.gnu.org; Mon, 25 Oct 2010 18:24:33 -0400 Received: from mx02.qsc.de ([213.148.130.14]:44411) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PAVSr-00034J-Qp; Mon, 25 Oct 2010 18:24:26 -0400 Received: from [192.168.178.22] (port-92-204-92-55.dynamic.qsc.de [92.204.92.55]) by mx02.qsc.de (Postfix) with ESMTP id 0E0551E38B; Tue, 26 Oct 2010 00:24:00 +0200 (CEST) Message-ID: <4CC60380.20107@net-b.de> Date: Tue, 26 Oct 2010 00:24:00 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.11) Gecko/20101013 SUSE/3.1.5 Thunderbird/3.1.5 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch,Fortran] PRs 45451 / 43018: Fixes for allocatables X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. 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, this patch fixes two things: a) PR 43018: For duplicate_allocatable the size was wrong: gfortran used for scalars the size of the pointer and not the size of the type. I have not added a test case as it was found via the valgrind error of gfortran.de/alloc_comp_scalar_1.f90; the test case also fails one one system (s390?). b) PR 45451: If one does an ALLOCATE with SOURCE=, one needs to do a deep copy if there are allocatable components. Without the non-variable case, it fails for the first ALLOCATE statement in gfortran.dg/allocate_alloc_opt_10.f90, where the source is an EXPR_STRUCTURE. Build an regtested on x86-64-linux. OK for the trunk? Tobias PS: This patch does not fix all problems with PR 45451. It also does not fix the case of a polymorphic SOURCE= with allocatable components (cf. new PR 46174). 2010-10-25 Tobias Burnus PR fortran/45451 * trans-stmt.c (gfc_trans_allocate): Do a deep-copy for SOURCE=. PR fortran/43018 * trans-array.c (duplicate_allocatable): Use size of type and not the size of the pointer to the type. 2010-10-25 Tobias Burnus gfortran.dg/class_allocate_5.f90 PR fortran/45451 * gfortran.dg/class_allocate_5.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 52ba831..db05734 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6072,7 +6072,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, null_data = gfc_finish_block (&block); gfc_init_block (&block); - size = TYPE_SIZE_UNIT (type); + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); if (!no_malloc) { tmp = gfc_call_malloc (&block, type, size); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 6e1a20b..d079230 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4487,8 +4487,12 @@ gfc_trans_allocate (gfc_code * code) /* Initialization via SOURCE block (or static default initializer). */ gfc_expr *rhs = gfc_copy_expr (code->expr3); - if (al->expr->ts.type == BT_CLASS) + if (al->expr->ts.type == BT_CLASS && rhs->expr_type == EXPR_VARIABLE + && rhs->ts.type != BT_CLASS) + tmp = gfc_trans_assignment (expr, rhs, false, false); + else if (al->expr->ts.type == BT_CLASS) { + /* TODO: One needs to do a deep-copy for BT_CLASS; cf. PR 46174. */ gfc_se dst,src; if (rhs->ts.type == BT_CLASS) gfc_add_component_ref (rhs, "$data"); diff --git a/gcc/testsuite/gfortran.dg/class_allocate_5.f90 b/gcc/testsuite/gfortran.dg/class_allocate_5.f90 new file mode 100644 index 0000000..592161e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_5.f90 @@ -0,0 +1,34 @@ +! { dg-do run } +! +! PR fortran/45451 +! +! Contributed by Salvatore Filippone and Janus Weil +! +! Check that ALLOCATE with SOURCE= does a deep copy. +! +program bug23 + implicit none + + type :: psb_base_sparse_mat + integer, allocatable :: irp(:) + end type psb_base_sparse_mat + + class(psb_base_sparse_mat), allocatable :: a + type(psb_base_sparse_mat) :: acsr + + allocate(acsr%irp(4)) + acsr%irp(1:4) = (/1,3,4,5/) + + write(*,*) acsr%irp(:) + + allocate(a,source=acsr) + + write(*,*) a%irp(:) + + call move_alloc(acsr%irp, a%irp) + + write(*,*) a%irp(:) + + if (any (a%irp /= [1,3,4,5])) call abort() +end program bug23 +