diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-02-21 09:06:57 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-02-21 09:06:57 +0000 |
| commit | e8393d495a7b1365ec8a7e88a3371c898289425a (patch) | |
| tree | 1b9dc5c56919f62925c5e6055abd1a153bdf2466 /gcc/fortran/class.c | |
| parent | 90af79f40b0a92d0ff83fd000c8ff3a1d348eba9 (diff) | |
| download | gcc-e8393d495a7b1365ec8a7e88a3371c898289425a.tar.gz | |
2014-02-21 Janus Weil <janus@gcc.gnu.org>
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 <janus@gcc.gnu.org>
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
Diffstat (limited to 'gcc/fortran/class.c')
| -rw-r--r-- | gcc/fortran/class.c | 25 |
1 files changed, 18 insertions, 7 deletions
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 8af9172dfcd..fc228cfde1b 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 |