From e8393d495a7b1365ec8a7e88a3371c898289425a Mon Sep 17 00:00:00 2001 From: janus Date: Fri, 21 Feb 2014 09:06:57 +0000 Subject: [PATCH] 2014-02-21 Janus Weil PR fortran/60234 * gfortran.h (gfc_build_class_symbol): Removed argument. * class.c (gfc_add_component_ref): Fix up missing vtype if necessary. (gfc_build_class_symbol): Remove argument 'delayed_vtab'. vtab is always delayed now, except for unlimited polymorphics. (comp_is_finalizable): Procedure pointer components are not finalizable. * decl. (build_sym, build_struct, attr_decl1): Removed argument of 'gfc_build_class_symbol'. * match.c (copy_ts_from_selector_to_associate, select_type_set_tmp): Ditto. * symbol.c (gfc_set_default_type): Ditto. 2014-02-21 Janus Weil PR fortran/60234 * gfortran.dg/finalize_23.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@207986 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 14 ++++++++++++++ gcc/fortran/class.c | 25 ++++++++++++++++++------- gcc/fortran/decl.c | 9 +++------ gcc/fortran/gfortran.h | 2 +- gcc/fortran/match.c | 5 ++--- gcc/fortran/symbol.c | 2 +- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/finalize_23.f90 | 31 +++++++++++++++++++++++++++++++ 8 files changed, 75 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/finalize_23.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b0c0c57..c27a1d0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2014-02-21 Janus Weil + + PR fortran/60234 + * gfortran.h (gfc_build_class_symbol): Removed argument. + * class.c (gfc_add_component_ref): Fix up missing vtype if necessary. + (gfc_build_class_symbol): Remove argument 'delayed_vtab'. vtab is always + delayed now, except for unlimited polymorphics. + (comp_is_finalizable): Procedure pointer components are not finalizable. + * decl. (build_sym, build_struct, attr_decl1): Removed argument of + 'gfc_build_class_symbol'. + * match.c (copy_ts_from_selector_to_associate, select_type_set_tmp): + Ditto. + * symbol.c (gfc_set_default_type): Ditto. + 2014-02-19 Janus Weil PR fortran/60232 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 8af9172..fc228cf 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -218,6 +218,14 @@ gfc_add_component_ref (gfc_expr *e, const char *name) break; tail = &((*tail)->next); } + if (derived->components->next->ts.type == BT_DERIVED && + derived->components->next->ts.u.derived == NULL) + { + /* Fix up missing vtype. */ + gfc_symbol *vtab = gfc_find_derived_vtab (derived->components->ts.u.derived); + gcc_assert (vtab); + derived->components->next->ts.u.derived = vtab->ts.u.derived; + } if (*tail != NULL && strcmp (name, "_data") == 0) next = *tail; (*tail) = gfc_get_ref(); @@ -543,7 +551,7 @@ gfc_intrinsic_hash_value (gfc_typespec *ts) bool gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, - gfc_array_spec **as, bool delayed_vtab) + gfc_array_spec **as) { char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; gfc_symbol *fclass; @@ -637,16 +645,17 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, if (!gfc_add_component (fclass, "_vptr", &c)) return false; c->ts.type = BT_DERIVED; - if (delayed_vtab - || (ts->u.derived->f2k_derived - && ts->u.derived->f2k_derived->finalizers)) - c->ts.u.derived = NULL; - else + + if (ts->u.derived->attr.unlimited_polymorphic) { vtab = gfc_find_derived_vtab (ts->u.derived); gcc_assert (vtab); c->ts.u.derived = vtab->ts.u.derived; } + else + /* Build vtab later. */ + c->ts.u.derived = NULL; + c->attr.access = ACCESS_PRIVATE; c->attr.pointer = 1; } @@ -790,7 +799,9 @@ has_finalizer_component (gfc_symbol *derived) static bool comp_is_finalizable (gfc_component *comp) { - if (comp->attr.allocatable && comp->ts.type != BT_CLASS) + if (comp->attr.proc_pointer) + return false; + else if (comp->attr.allocatable && comp->ts.type != BT_CLASS) return true; else if (comp->ts.type == BT_DERIVED && !comp->attr.pointer && (comp->ts.u.derived->attr.alloc_comp diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 8831b19..2d405fe 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1199,7 +1199,7 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred, sym->attr.implied_index = 0; if (sym->ts.type == BT_CLASS) - return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false); + return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as); return true; } @@ -1656,10 +1656,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, scalar: if (c->ts.type == BT_CLASS) { - bool delayed = (gfc_state_stack->sym == c->ts.u.derived) - || (!c->ts.u.derived->components - && !c->ts.u.derived->attr.zero_comp); - bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed); + bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as); if (t) t = t2; @@ -6340,7 +6337,7 @@ attr_decl1 (void) } if (sym->ts.type == BT_CLASS - && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false)) + && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as)) { m = MATCH_ERROR; goto cleanup; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 77f768e5..197798c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2988,7 +2988,7 @@ bool gfc_is_class_container_ref (gfc_expr *e); gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *); unsigned int gfc_hash_value (gfc_symbol *); bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, - gfc_array_spec **, bool); + gfc_array_spec **); gfc_symbol *gfc_find_derived_vtab (gfc_symbol *); gfc_symbol *gfc_find_vtab (gfc_typespec *); gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*, diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index eda1bf3..171774c 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5148,8 +5148,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) assoc_sym->ts.type = BT_CLASS; assoc_sym->ts.u.derived = CLASS_DATA (selector)->ts.u.derived; assoc_sym->attr.pointer = 1; - gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr, - &assoc_sym->as, false); + gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr, &assoc_sym->as); } } @@ -5273,7 +5272,7 @@ select_type_set_tmp (gfc_typespec *ts) if (ts->type == BT_CLASS) gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr, - &tmp->n.sym->as, false); + &tmp->n.sym->as); } /* Add an association for it, so the rest of the parser knows it is diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index dad7b33..6666872 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -262,7 +262,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) if (ts->type == BT_CHARACTER && ts->u.cl) sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl); else if (ts->type == BT_CLASS - && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false)) + && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as)) return false; if (sym->attr.is_bind_c == 1 && gfc_option.warn_c_binding_type) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index df82431..a247f72 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-02-21 Janus Weil + + PR fortran/60234 + * gfortran.dg/finalize_23.f90: New. + 2014-02-21 Adam Butcher PR c++/60052 diff --git a/gcc/testsuite/gfortran.dg/finalize_23.f90 b/gcc/testsuite/gfortran.dg/finalize_23.f90 new file mode 100644 index 0000000..ea39729 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_23.f90 @@ -0,0 +1,31 @@ +! { dg-do compile } +! +! PR 60234: [4.9 Regression] [OOP] ICE in generate_finalization_wrapper at fortran/class.c:1883 +! +! Contribued by Antony Lewis + +module ObjectLists + implicit none + + Type TObjectList + contains + FINAL :: finalize + end Type + + Type, extends(TObjectList):: TRealCompareList + end Type + +contains + + subroutine finalize(L) + Type(TObjectList) :: L + end subroutine + + + integer function CompareReal(this) + Class(TRealCompareList) :: this + end function + +end module + +! { dg-final { cleanup-modules "ObjectLists" } } -- 2.7.4