From 0b2d443bef10e972db37d28d4626ab8dbbf4abcc Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Thu, 16 Aug 2012 00:11:03 +0200 Subject: [PATCH] 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/ChangeLog | 8 +++++++ gcc/fortran/resolve.c | 5 ++++ gcc/testsuite/ChangeLog | 6 +++++ .../gfortran.dg/typebound_call_24.f03 | 24 +++++++++++++++++++ 4 files changed, 43 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/typebound_call_24.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7161b62e09e..17b14a98ec6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +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-14 Mikael Morin PR fortran/47586 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c706b8956d7..ac5a3626066 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) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6af76ee9e96..9c454bf8290 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2012-08-15 Janus Weil + + PR fortran/54243 + PR fortran/54244 + * gfortran.dg/typebound_call_24.f03: New. + 2012-08-15 Bill Schmidt PR tree-optimization/54245 diff --git a/gcc/testsuite/gfortran.dg/typebound_call_24.f03 b/gcc/testsuite/gfortran.dg/typebound_call_24.f03 new file mode 100644 index 00000000000..48d63dc6023 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_24.f03 @@ -0,0 +1,24 @@ +! { dg-do compile } +! +! PR 54243: [OOP] ICE (segfault) in gfc_type_compatible for invalid BT_CLASS +! +! Contributed by Sylwester Arabas + +module aqq_m + type :: aqq_t + contains + procedure :: aqq_init + end type + contains + subroutine aqq_init(this) + class(aqq_t) :: this + end subroutine +end module + +program bug2 + use aqq_m + class(aqq_t) :: aqq ! { dg-error "must be dummy, allocatable or pointer" } + call aqq%aqq_init +end program + +! { dg-final { cleanup-modules "aqq_m" } }