[PATCH] fortran: Fix default initialization of finalizable non-polymorphic intent(out) arguments [PR116829]

[Andre Vehreschild]

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 <trnka@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 <trnka@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