| Message ID | 4CC60380.20107@net-b.de |
|---|---|
| State | New |
| Headers | show |
Hi Tobias, > 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? I think the patch is ok. Thanks for taking care of this. > PS: This patch does not fix all problems with PR 45451. You mean comment #8/9? Cheers, Janus
Hi Janus, On 10/26/2010 08:37 AM, Janus Weil wrote: > I think the patch is ok. Thanks for taking care of this. Thanks for the review. (Committed as Rev. 165936.) >> PS: This patch does not fix all problems with PR 45451. > You mean comment #8/9? Actually, I rather mean the issues I mentioned in comment 16. I am not sure whether comment 8 is a new bug of the consequence of a missing deep copy. And regarding comment 9: I am too lazy to debug an invalid program - at least until the known problems are fixed. Frankly, I have no idea how to best solve the deep-copying problem for polymorphic types. One could think of creating hidden COPY and FREE type-bound procedures, which free the added allocatables of the type and then call the parent free function. That is: if (a$vtab->free) free(a) as deallocation function -- and in the deallocation function: if (a$vtab->parent->free) free(a) if a type extension does not have a allocatable components, it simply directly points to the parent. Tobias
2010-10-25 Tobias Burnus <burnus@net-b.de> 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 <burnus@net-b.de>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 +