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

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

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

Bernhard Reutner-Fischer wrote:
> On Sat, Apr 05, 2014 at 12:16:23AM +0200, Tobias Burnus wrote:
>> +	    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? :)

It is supposed to propagate the information whether any of the 
components ("c") has a derived type. However, I made a typo: It should 
be "&has_final2" instead of "&has_final".

If you/one prefers, one can also do: "has_final |= has_final2;"

Tobias

Hello,

Le 06/04/2014 18:05, Tobias Burnus a écrit :
> Bernhard Reutner-Fischer wrote:
>> On Sat, Apr 05, 2014 at 12:16:23AM +0200, Tobias Burnus wrote:
>>> +        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? :)
> 
> It is supposed to propagate the information whether any of the
> components ("c") has a derived type. However, I made a typo: It should
> be "&has_final2" instead of "&has_final".
> 

gfc_is_finalizable couldn't be used?

Mikael Morin wrote:
> Le 06/04/2014 18:05, Tobias Burnus a écrit :
>> It is supposed to propagate the information whether any of the 
>> components ("c") has a derived type. However, I made a typo: It 
>> should be "&has_final2" instead of "&has_final". 
> gfc_is_finalizable couldn't be used?

No that requires that gfc_resolve_finalizers has run to setup some 
variables - and we are in that function … If one tried to run it 
nevertheless, gfortran ICEs ;-)

Tobias

Le 06/04/2014 19:46, Tobias Burnus a écrit :
> Mikael Morin wrote:
>> Le 06/04/2014 18:05, Tobias Burnus a écrit :
>>> It is supposed to propagate the information whether any of the
>>> components ("c") has a derived type. However, I made a typo: It
>>> should be "&has_final2" instead of "&has_final". 
>> gfc_is_finalizable couldn't be used?
> 
> No that requires that gfc_resolve_finalizers has run to setup some
> variables - and we are in that function … If one tried to run it
> nevertheless, gfortran ICEs ;-)
> 
Argh. great. What about the use_assoc thing?  Why is that needed?

Mikael Morin wrote:
> Argh. great. What about the use_assoc thing?  Why is that needed?

Frankly, I don't know. In terms of the code, the problem is that 
attr.use_assoc is zero and, hence, the compiler generates a call to some 
external version which lacks the module name - that symbol is not found 
and, unsurprisingly, there is a link-time failure (symbol reference not 
found).

However, I have a completely untested hypothesis: The derived type is 
use associated (fact) when following sym->ts.u.derived to the vtab and 
then further to vtab->_final one at some point does no longer access a 
use associated variable but the one of the module. As it is used in the 
module, it is not use associated and lacks that attribute. In that sense 
it is wrong to set it in trans.c as my patch does. However, that section 
of the code is only reached after the module generation has finished. 
Hence, it is should be safe to modify the attribute. (If it had been 
generated in the module, final_expr->...->sym->backend_decl would be set 
and we could use it directly.)

Tobias

Le 06/04/2014 20:30, Tobias Burnus a écrit :
> Mikael Morin wrote:
>> Argh. great. What about the use_assoc thing?  Why is that needed?
> 
> Frankly, I don't know. In terms of the code, the problem is that
> attr.use_assoc is zero and, hence, the compiler generates a call to some
> external version which lacks the module name - that symbol is not found
> and, unsurprisingly, there is a link-time failure (symbol reference not
> found).
> 
> However, I have a completely untested hypothesis: The derived type is
> use associated (fact) when following sym->ts.u.derived to the vtab and
> then further to vtab->_final one at some point does no longer access a
> use associated variable but the one of the module. As it is used in the
> module, it is not use associated and lacks that attribute. In that sense
> it is wrong to set it in trans.c as my patch does. However, that section
> of the code is only reached after the module generation has finished.
> Hence, it is should be safe to modify the attribute. (If it had been
> generated in the module, final_expr->...->sym->backend_decl would be set
> and we could use it directly.)
> 

Unless I have messed up something on my side, the testcase seems to work
here without the use_assoc change; could you double-check?  The patch is
ok if it works (without the trans.c part of course).

Mikael