diff options
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index dc9637a..96162e5 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8309,12 +8309,12 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) sym_has_alloc_comp = (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS) && sym->ts.u.derived->attr.alloc_comp; + has_finalizer = sym->ts.type == BT_CLASS || sym->ts.type == BT_DERIVED + ? gfc_is_finalizable (sym->ts.u.derived, NULL) : false; /* Make sure the frontend gets these right. */ - if (!(sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp)) - fatal_error ("Possible front-end bug: Deferred array size without pointer, " - "allocatable attribute or derived type without allocatable " - "components."); + gcc_assert (sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp + || has_finalizer); gfc_save_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); @@ -8343,7 +8343,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) /* Although static, derived types with default initializers and allocatable components must not be nulled wholesale; instead they are treated component by component. */ - if (TREE_STATIC (descriptor) && !sym_has_alloc_comp) + if (TREE_STATIC (descriptor) && !sym_has_alloc_comp && !has_finalizer) { /* SAVEd variables are not freed on exit. */ gfc_trans_static_array_pointer (sym); @@ -8356,7 +8356,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) /* Get the descriptor type. */ type = TREE_TYPE (sym->backend_decl); - if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable)) + if ((sym_has_alloc_comp || (has_finalizer && sym->ts.type != BT_CLASS)) + && !(sym->attr.pointer || sym->attr.allocatable)) { if (!sym->attr.save && !(TREE_STATIC (sym->backend_decl) && sym->attr.is_main_program)) @@ -8391,9 +8392,17 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) /* Allocatable arrays need to be freed when they go out of scope. The allocatable components of pointers must not be touched. */ - has_finalizer = sym->ts.type == BT_CLASS || sym->ts.type == BT_DERIVED - ? gfc_is_finalizable (sym->ts.u.derived, NULL) : false; - if ((!sym->attr.allocatable || !has_finalizer) + if (!sym->attr.allocatable && has_finalizer && sym->ts.type != BT_CLASS + && !sym->attr.pointer && !sym->attr.artificial && !sym->attr.save + && !sym->ns->proc_name->attr.is_main_program) + { + gfc_expr *e; + sym->attr.referenced = 1; + e = gfc_lval_expr_from_sym (sym); + gfc_add_finalizer_call (&cleanup, e); + gfc_free_expr (e); + } + else if ((!sym->attr.allocatable || !has_finalizer) && sym_has_alloc_comp && !(sym->attr.function || sym->attr.result) && !sym->attr.pointer && !sym->attr.save && !sym->ns->proc_name->attr.is_main_program) |