[Patch, Fortran] PRs 60495/58880: Fix issues with finalization expressions

[Bernhard Reutner-Fischer]

On Sat, Apr 05, 2014 at 12:16:23AM +0200, Tobias Burnus wrote:
> This patch ensures that the finalization expression is generated and that
> use-associated finalizers are properly accessed.
> 
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
> 
> Tobias

> 2014-04-04  Tobias Burnus  <burnus@net-b.de>
> 
> 	PR fortran/58880
> 	PR fortran/60495
> 	* resolve.c (gfc_resolve_finalizers): Ensure that vtables
> 	and finalization wrappers are generated.
> 	* trans.c (gfc_build_final_call): Ensure that use_assoc
> 	is set for the finalization wrapper when applicable.
> 
> 2014-04-04  Tobias Burnus  <burnus@net-b.de>
> 
> 	PR fortran/58880
> 	PR fortran/60495
> 	* gfortran.dg/finalize_25.f90: New.
> 
> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
> index 6e23e57..38755fe 100644
> --- a/gcc/fortran/resolve.c
> +++ b/gcc/fortran/resolve.c
> @@ -11200,15 +11200,36 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
>     the requirements of the standard for procedures used as finalizers.  */
>  
>  static bool
> -gfc_resolve_finalizers (gfc_symbol* derived)
> +gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
>  {
>    gfc_finalizer* list;
>    gfc_finalizer** prev_link; /* For removing wrong entries from the list.  */
>    bool result = true;
>    bool seen_scalar = false;
> +  gfc_symbol *vtab;
> +  gfc_component *c;
>  
> +  /* Return early when not finalizable. Additionally, ensure that derived-type
> +     components have a their finalizables resolved.  */
>    if (!derived->f2k_derived || !derived->f2k_derived->finalizers)
> -    return true;
> +    {
> +      bool has_final = false;
> +      for (c = derived->components; c; c = c->next)
> +	if (c->ts.type == BT_DERIVED
> +	    && !c->attr.pointer && !c->attr.proc_pointer && !c->attr.allocatable)
> +	  {
> +	    bool has_final2 = false;
> +	    if (!gfc_resolve_finalizers (c->ts.u.derived, &has_final))
> +	      return false;  /* Error.  */
> +	    has_final = has_final || has_final2;

debugging-leftover? What's the purpose of has_final2?
Did you mean has_final |= true i.e. has_final = true here?
What am i missing? :)

thanks,
> +	  }
> +      if (!has_final)
> +	{
> +	  if (finalizable)
> +	    *finalizable = false;
> +	  return true;
> +	}
> +    }
>  
>    /* Walk over the list of finalizer-procedures, check them, and if any one
>       does not fit in with the standard's definition, print an error and remove
> @@ -11330,12 +11351,15 @@ gfc_resolve_finalizers (gfc_symbol* derived)
>  	/* Remove wrong nodes immediately from the list so we don't risk any
>  	   troubles in the future when they might fail later expectations.  */
>  error:
> -	result = false;
>  	i = list;
>  	*prev_link = list->next;
>  	gfc_free_finalizer (i);
> +	result = false;
>      }
>  
> +  if (result == false)
> +    return false;
> +
>    /* Warn if we haven't seen a scalar finalizer procedure (but we know there
>       were nodes in the list, must have been for arrays.  It is surely a good
>       idea to have a scalar version there if there's something to finalize.  */
> @@ -11344,8 +11368,14 @@ error:
>  		 " defined at %L, suggest also scalar one",
>  		 derived->name, &derived->declared_at);
>  
> -  gfc_find_derived_vtab (derived);
> -  return result;
> +  vtab = gfc_find_derived_vtab (derived);
> +  c = vtab->ts.u.derived->components->next->next->next->next->next;
> +  gfc_set_sym_referenced (c->initializer->symtree->n.sym);
> +
> +  if (finalizable)
> +    *finalizable = true;
> +
> +  return true;
>  }
>  
>  
> @@ -12513,7 +12543,7 @@ resolve_fl_derived (gfc_symbol *sym)
>      return false;
>  
>    /* Resolve the finalizer procedures.  */
> -  if (!gfc_resolve_finalizers (sym))
> +  if (!gfc_resolve_finalizers (sym, NULL))
>      return false;
>  
>    if (sym->attr.is_class && sym->ts.u.derived == NULL)
> diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
> index 5961c26..9ea859e 100644
> --- a/gcc/fortran/trans.c
> +++ b/gcc/fortran/trans.c
> @@ -869,6 +869,9 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
>    gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
>    gcc_assert (var);
>  
> +  if (final_wrapper->symtree->n.sym->module)
> +    final_wrapper->symtree->n.sym->attr.use_assoc = 1;
> +
>    gfc_start_block (&block);
>    gfc_init_se (&se, NULL);
>    gfc_conv_expr (&se, final_wrapper);
> diff --git a/gcc/testsuite/gfortran.dg/finalize_25.f90 b/gcc/testsuite/gfortran.dg/finalize_25.f90
> new file mode 100644
> index 0000000..73dc568
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/finalize_25.f90
> @@ -0,0 +1,55 @@
> +! { dg-do run }
> +!
> +! PR fortran/58880
> +! PR fortran/60495
> +!
> +! Contributed by Andrew Benson and Janus Weil
> +!
> +
> +module gn
> +  implicit none
> +  type sl
> +     integer, allocatable, dimension(:) :: lv
> +   contains
> +     final :: sld
> +  end type
> +  type :: nde
> +     type(sl) :: r
> +  end type nde
> +
> +  integer :: cnt = 0
> +
> +contains
> +
> +  subroutine sld(s)
> +    type(sl) :: s
> +    cnt = cnt + 1
> +    ! print *,'Finalize sl'
> +  end subroutine
> +  subroutine ndm(s)
> +    type(nde), intent(inout) :: s
> +    type(nde)                :: i    
> +    i=s
> +  end subroutine ndm
> +end module
> +
> +program main
> +  use gn
> +  type :: nde2
> +     type(sl) :: r
> +  end type nde2
> +  type(nde) :: x
> +
> +  cnt = 0
> +  call ndm(x)
> +  if (cnt /= 2) call abort()
> +
> +  cnt = 0
> +  call ndm2()
> +  if (cnt /= 3) call abort()
> +contains
> +  subroutine ndm2
> +    type(nde2) :: s,i
> +    i=s
> +  end subroutine ndm2
> +end program main