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 <bur...@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 <bur...@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