Hi Tomáš,
one small nit: I would prefer to use i = -1 as the initializer for component of
the derived type, because 0 is a default generated one and that way one can
distinguish them. With that, ok for mainline and thanks for the patch.
- Andre
On Wed, 25 Sep 2024 17:20:12 +0200
Tomáš Trnka <tr...@scm.com> wrote:
> This fixes PR fortran/116829 by making sure that s->value is always
> applied to non-allocatable BT_DERIVED intent(out) arguments, no matter
> if they are finalizable or not.
>
> Tested on x86_64-pc-linux-gnu (Fedora 40), any feedback is welcome.
>
> gcc/fortran/ChangeLog:
>
> * 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/ChangeLog:
>
> * gfortran.dg/derived_init_7.f90: New test.
>
> Signed-off-by: Tomáš Trnka <tr...@scm.com>
> ---
> gcc/fortran/trans-decl.cc | 9 +---
> gcc/testsuite/gfortran.dg/derived_init_7.f90 | 49 ++++++++++++++++++++
> 2 files changed, 51 insertions(+), 7 deletions(-)
> create mode 100644 gcc/testsuite/gfortran.dg/derived_init_7.f90
>
> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index 8231bd255d6..50e8adcb819 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc
> @@ -4461,7 +4461,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)
> @@ -4496,7 +4495,6 @@ init_intent_out_dt (gfc_symbol * proc_sym,
> gfc_wrapped_block * block) tmp = gfc_deallocate_alloc_comp (s->ts.u.derived,
> s->backend_decl,
> s->as ? s->as->rank : 0);
> - dealloc_with_value = s->value;
> }
>
> if (tmp != NULL_TREE && (s->attr.optional
> @@ -4507,13 +4505,10 @@ 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);
> + if (s->value && !s->attr.allocatable)
> {
> - gfc_add_expr_to_block (&init, tmp);
> gfc_init_default_dt (s, &init, false);
> - dealloc_with_value = false;
> }
> }
> else if (f->sym && f->sym->attr.intent == INTENT_OUT
> diff --git a/gcc/testsuite/gfortran.dg/derived_init_7.f90
> b/gcc/testsuite/gfortran.dg/derived_init_7.f90 new file mode 100644
> index 00000000000..8efb7ba1c77
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/derived_init_7.f90
> @@ -0,0 +1,49 @@
> +! { dg-do run }
> +! Check that finalizable intent(out) dummy arguments are first finalized
> +! and then correctly default-initialized (PR116829)
> +!
> +module FinalizableIntentOutTestModule
> + implicit none
> +
> + type :: AapType
> + integer :: i = 0
> + contains
> + final :: Finalizer
> + end type
> +
> +contains
> +
> + subroutine Finalizer(self)
> + type(AapType), intent(inout) :: self
> +
> + ! Fail if Finalizer gets called again on an already finalized object
> + if (self%i == 42) stop 1
> +
> + self%i = 42 ! Nobody should ever see this value after finalization
> + end subroutine
> +
> +end module
> +
> +
> +program test
> + use FinalizableIntentOutTestModule
> +
> + implicit none
> +
> + type(AapType) :: aap
> +
> + ! Set "i" to nonzero so that initialization in MakeAap has something to do
> + aap%i = 1
> +
> + call MakeAap(aap)
> +
> +contains
> +
> + subroutine MakeAap(a)
> + type(AapType), intent(out) :: a
> +
> + ! Fail if "a" wasn't initialized properly
> + if (a%i /= 0) stop 2
> + end subroutine
> +
> +end program
--
Andre Vehreschild * Email: vehre ad gmx dot de
