From 0b2d443bef10e972db37d28d4626ab8dbbf4abcc Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Thu, 16 Aug 2012 00:11:03 +0200 Subject: re PR fortran/54243 ([OOP] ICE (segfault) in gfc_type_compatible for invalid BT_CLASS) 2012-08-15 Janus Weil PR fortran/54243 PR fortran/54244 * resolve.c (check_typebound_baseobject): Check for class_ok attribute. (resolve_procedure_interface,resolve_fl_derived0): Copy class_ok attribute. 2012-08-15 Janus Weil PR fortran/54243 PR fortran/54244 * gfortran.dg/typebound_call_24.f03: New. From-SVN: r190420 --- gcc/fortran/resolve.c | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c706b89..ac5a362 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -237,6 +237,7 @@ resolve_procedure_interface (gfc_symbol *sym) sym->attr.always_explicit = ifc->attr.always_explicit; sym->attr.ext_attr |= ifc->attr.ext_attr; sym->attr.is_bind_c = ifc->attr.is_bind_c; + sym->attr.class_ok = ifc->attr.class_ok; /* Copy array spec. */ sym->as = gfc_copy_array_spec (ifc->as); if (sym->as) @@ -5795,6 +5796,9 @@ check_typebound_baseobject (gfc_expr* e) gcc_assert (base->ts.type == BT_DERIVED || base->ts.type == BT_CLASS); + if (base->ts.type == BT_CLASS && !gfc_expr_attr (base).class_ok) + return FAILURE; + /* F08:C611. */ if (base->ts.type == BT_DERIVED && base->ts.u.derived->attr.abstract) { @@ -11982,6 +11986,7 @@ resolve_fl_derived0 (gfc_symbol *sym) c->attr.recursive = ifc->attr.recursive; c->attr.always_explicit = ifc->attr.always_explicit; c->attr.ext_attr |= ifc->attr.ext_attr; + c->attr.class_ok = ifc->attr.class_ok; /* Replace symbols in array spec. */ if (c->as) { -- cgit v1.1