diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2025-02-07 12:46:44 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2025-02-07 12:46:56 +0000 |
| commit | 251aa524a314faa749b7dd1b7da048e6e6476015 (patch) | |
| tree | 624f2fc06cd9000e6d4b01f8de7b4ab2cf433430 /gcc/fortran | |
| parent | 4931a637479aba35e35c50a86f58ecd6262bc487 (diff) | |
| download | gcc-251aa524a314faa749b7dd1b7da048e6e6476015.zip gcc-251aa524a314faa749b7dd1b7da048e6e6476015.tar.gz gcc-251aa524a314faa749b7dd1b7da048e6e6476015.tar.bz2 | |
Fortran: Fix default init of finalizable derived argus [PR116829]
2025-02-07 Tomáš Trnka <trnka@scm.com>
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.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/trans-decl.cc | 21 |
1 files changed, 6 insertions, 15 deletions
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 |