From cb41490017822947d5d5c9dbf713af00af306110 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 12 Apr 2014 00:35:47 +0200 Subject: [PATCH] re PR fortran/58880 ([OOP] ICE on valid with FINAL function and type extension) 2014-04-11 Tobias Burnus PR fortran/58880 PR fortran/60495 * resolve.c (gfc_resolve_finalizers): Ensure that vtables and finalization wrappers are generated. 2014-04-11 Tobias Burnus PR fortran/58880 PR fortran/60495 * gfortran.dg/finalize_25.f90: New. From-SVN: r209327 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/resolve.c | 42 +++++++++++++++++++---- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/finalize_25.f90 | 55 +++++++++++++++++++++++++++++++ 4 files changed, 104 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/finalize_25.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 572a7ff..c14e209 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2014-04-11 Tobias Burnus + + PR fortran/58880 + PR fortran/60495 + * resolve.c (gfc_resolve_finalizers): Ensure that vtables + and finalization wrappers are generated. + 2014-04-11 Janne Blomqvist * intrinsic.texi (RANDOM_SEED): Improve example. 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/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9e89527..ad54ae8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-04-11 Tobias Burnus + + PR fortran/58880 + PR fortran/60495 + * gfortran.dg/finalize_25.f90: New. + 2014-04-11 Joern Rennecke * gcc.target/epiphany/t1068-2.c: New file. diff --git a/gcc/testsuite/gfortran.dg/finalize_25.f90 b/gcc/testsuite/gfortran.dg/finalize_25.f90 new file mode 100644 index 0000000..cdbec4c --- /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 -- 2.7.4