From 251aa524a314faa749b7dd1b7da048e6e6476015 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 7 Feb 2025 12:46:44 +0000 Subject: Fortran: Fix default init of finalizable derived argus [PR116829] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 2025-02-07 Tomáš Trnka gcc/fortran PR fortran/116829 * trans-decl.cc (init_intent_out_dt): Always call gfc_init_default_dt() for BT_DERIVED to apply s->value if the symbol isn't allocatable. Also simplify the logic a bit. gcc/testsuite/ PR fortran/116829 * gfortran.dg/derived_init_7.f90: New test. --- gcc/fortran/trans-decl.cc | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 017f184..83f8130 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -4551,7 +4551,6 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) tree tmp; tree present; gfc_symbol *s; - bool dealloc_with_value = false; gfc_init_block (&init); for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) @@ -4582,12 +4581,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) by the caller. */ if (tmp == NULL_TREE && !s->attr.allocatable && s->ts.u.derived->attr.alloc_comp) - { - tmp = gfc_deallocate_alloc_comp (s->ts.u.derived, - s->backend_decl, - s->as ? s->as->rank : 0); - dealloc_with_value = s->value; - } + tmp = gfc_deallocate_alloc_comp (s->ts.u.derived, + s->backend_decl, + s->as ? s->as->rank : 0); if (tmp != NULL_TREE && (s->attr.optional || s->ns->proc_name->attr.entry_master)) @@ -4597,14 +4593,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) present, tmp, build_empty_stmt (input_location)); } - if (tmp != NULL_TREE && !dealloc_with_value) - gfc_add_expr_to_block (&init, tmp); - else if (s->value && !s->attr.allocatable) - { - gfc_add_expr_to_block (&init, tmp); - gfc_init_default_dt (s, &init, false); - dealloc_with_value = false; - } + gfc_add_expr_to_block (&init, tmp); + if (s->value && !s->attr.allocatable) + gfc_init_default_dt (s, &init, false); } else if (f->sym && f->sym->attr.intent == INTENT_OUT && f->sym->ts.type == BT_CLASS -- cgit v1.1