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

gcc/fortran/ChangeLog

+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

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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/typebound_call_24.f03

+! { 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" } }