Message ID | 533F2F37.8010304@net-b.de |
---|---|
State | New |
Headers | show |
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
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; + } + 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