diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2018-01-08 11:20:33 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2018-01-08 11:20:33 +0000 |
| commit | 8a9ee04785ae7c18ecd767ed0158a47f86b8d578 (patch) | |
| tree | 0a0943697205f58503baa1da74a60f0afcde7e67 /gcc/fortran/trans-stmt.c | |
| parent | 54182b8247817d7f92fec111fe0fcbf12f4e2827 (diff) | |
2018-01-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/83611
* decl.c (gfc_get_pdt_instance): If parameterized arrays have
an initializer, convert the kind parameters and add to the
component if the instance.
* trans-array.c (structure_alloc_comps): Add 'is_pdt_type' and
use it with case COPY_ALLOC_COMP. Call 'duplicate_allocatable'
for parameterized arrays. Clean up typos in comments. Convert
parameterized array initializers and copy into the array.
* trans-expr.c (gfc_trans_scalar_assign): Do a deep copy for
parameterized types.
*trans-stmt.c (trans_associate_var): Deallocate associate vars
as necessary, when they are PDT function results for example.
PR fortran/83731
* trans-array.c (structure_alloc_comps): Only compare len parms
when they are declared explicitly.
2018-01-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/83611
* gfortran.dg/pdt_15.f03 : Bump count of 'n.data = 0B' to 8.
* gfortran.dg/pdt_26.f03 : Bump count of '_malloc' to 9.
* gfortran.dg/pdt_27.f03 : New test.
PR fortran/83731
* gfortran.dg/pdt_28.f03 : New test.
git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@256335 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/trans-stmt.c')
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 74974d38096..ff6e5914319 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1634,6 +1634,16 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_conv_descriptor_span_set (&se.pre, desc, tmp); } + if (e->expr_type == EXPR_FUNCTION + && sym->ts.type == BT_DERIVED + && sym->ts.u.derived + && sym->ts.u.derived->attr.pdt_type) + { + tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, se.expr, + sym->as->rank); + gfc_add_expr_to_block (&se.post, tmp); + } + /* Done, register stuff as init / cleanup code. */ gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), gfc_finish_block (&se.post)); @@ -1810,10 +1820,31 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) else { gfc_expr *lhs; + tree res; lhs = gfc_lval_expr_from_sym (sym); - tmp = gfc_trans_assignment (lhs, e, false, true); - gfc_add_init_cleanup (block, tmp, NULL_TREE); + res = gfc_trans_assignment (lhs, e, false, true); + + tmp = sym->backend_decl; + if (e->expr_type == EXPR_FUNCTION + && sym->ts.type == BT_DERIVED + && sym->ts.u.derived + && sym->ts.u.derived->attr.pdt_type) + { + tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, tmp, + 0); + } + else if (e->expr_type == EXPR_FUNCTION + && sym->ts.type == BT_CLASS + && CLASS_DATA (sym)->ts.u.derived + && CLASS_DATA (sym)->ts.u.derived->attr.pdt_type) + { + tmp = gfc_class_data_get (tmp); + tmp = gfc_deallocate_pdt_comp (CLASS_DATA (sym)->ts.u.derived, + tmp, 0); + } + + gfc_add_init_cleanup (block, res, tmp); } /* Set the stringlength, when needed. */ |