diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2013-02-04 22:33:15 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2013-02-04 22:33:15 +0000 |
| commit | 16e247566db1df18a63965f8b3da7345459c6296 (patch) | |
| tree | b050a17024c43f8e674ed0aa5a78ec65c9e5d061 /gcc/fortran | |
| parent | 9ccd841a07944a30a4c17df1b0dd274b7e1c4431 (diff) | |
| download | gcc-16e247566db1df18a63965f8b3da7345459c6296.zip gcc-16e247566db1df18a63965f8b3da7345459c6296.tar.gz gcc-16e247566db1df18a63965f8b3da7345459c6296.tar.bz2 | |
re PR fortran/56008 ([F03] wrong code with lhs-realloc on assignment with derived types having allocatable components)
2013-02-04 Paul Thomas <pault@gcc.gnu.org>
PR fortran/56008
PR fortran/47517
* trans-array.c (gfc_alloc_allocatable_for_assignment): Save
the lhs descriptor before it is modified for reallocation. Use
it to deallocate allocatable components in the reallocation
block. Nullify allocatable components for newly (re)allocated
arrays.
2013-02-04 Paul Thomas <pault@gcc.gnu.org>
PR fortran/56008
* gfortran.dg/realloc_on _assign_16.f90 : New test.
PR fortran/47517
* gfortran.dg/realloc_on _assign_17.f90 : New test.
From-SVN: r195741
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 33 |
2 files changed, 43 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 50d7538..c22d3d9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2013-02-04 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/56008 + PR fortran/47517 + * trans-array.c (gfc_alloc_allocatable_for_assignment): Save + the lhs descriptor before it is modified for reallocation. Use + it to deallocate allocatable components in the reallocation + block. Nullify allocatable components for newly (re)allocated + arrays. + 2013-02-04 Mikael Morin <mikael@gcc.gnu.org> PR fortran/54195 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3e658c0..4553ddc 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7941,6 +7941,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tree lbound; tree ubound; tree desc; + tree old_desc; tree desc2; tree offset; tree jump_label1; @@ -8091,6 +8092,13 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, size1, size2); neq_size = gfc_evaluate_now (cond, &fblock); + /* Deallocation of allocatable components will have to occur on + reallocation. Fix the old descriptor now. */ + if ((expr1->ts.type == BT_DERIVED) + && expr1->ts.u.derived->attr.alloc_comp) + old_desc = gfc_evaluate_now (desc, &fblock); + else + old_desc = NULL_TREE; /* Now modify the lhs descriptor and the associated scalarizer variables. F2003 7.4.1.3: "If variable is or becomes an @@ -8201,12 +8209,30 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Realloc expression. Note that the scalarizer uses desc.data in the array reference - (*desc.data)[<element>]. */ gfc_init_block (&realloc_block); + + if ((expr1->ts.type == BT_DERIVED) + && expr1->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, old_desc, + expr1->rank); + gfc_add_expr_to_block (&realloc_block, tmp); + } + tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_REALLOC), 2, fold_convert (pvoid_type_node, array1), size2); gfc_conv_descriptor_data_set (&realloc_block, desc, tmp); + + if ((expr1->ts.type == BT_DERIVED) + && expr1->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_nullify_alloc_comp (expr1->ts.u.derived, desc, + expr1->rank); + gfc_add_expr_to_block (&realloc_block, tmp); + } + realloc_expr = gfc_finish_block (&realloc_block); /* Only reallocate if sizes are different. */ @@ -8224,6 +8250,13 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, desc, tmp); tmp = gfc_conv_descriptor_dtype (desc); gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc))); + if ((expr1->ts.type == BT_DERIVED) + && expr1->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_nullify_alloc_comp (expr1->ts.u.derived, desc, + expr1->rank); + gfc_add_expr_to_block (&alloc_block, tmp); + } alloc_expr = gfc_finish_block (&alloc_block); /* Malloc if not allocated; realloc otherwise. */ |