re PR fortran/54243 ([OOP] ICE (segfault) in gfc_type_compatible for invalid BT_CLASS)

2012-08-15  Janus Weil  <janus@gcc.gnu.org>

	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  <janus@gcc.gnu.org>

	PR fortran/54243
	PR fortran/54244
	* gfortran.dg/typebound_call_24.f03: New.

From-SVN: r190420
This commit is contained in:
Janus Weil 2012-08-16 00:11:03 +02:00
parent 4b78ca9d81
commit 0b2d443bef
4 changed files with 43 additions and 0 deletions

View File

@ -1,3 +1,11 @@
2012-08-15 Janus Weil <janus@gcc.gnu.org>
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 <mikael@gcc.gnu.org>
PR fortran/47586

View File

@ -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)
{

View File

@ -1,3 +1,9 @@
2012-08-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/54243
PR fortran/54244
* gfortran.dg/typebound_call_24.f03: New.
2012-08-15 Bill Schmidt <wschmidt@linux.vnet.ibm.com>
PR tree-optimization/54245

View File

@ -0,0 +1,24 @@
! { dg-do compile }
!
! PR 54243: [OOP] ICE (segfault) in gfc_type_compatible for invalid BT_CLASS
!
! Contributed by Sylwester Arabas <slayoo@staszic.waw.pl>
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" } }