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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7161b62e09e378268d094591d3dee11e162a90a5..17b14a98ec6e5de71fe1a4e38c2fc778b3f043bd 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c706b8956d7724e16576c8496e2b246eeb91497d..ac5a36260669fd3291e7d435e74ccca6415fbb89 100644 (file)
--- 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 6af76ee9e965e753806d781d986e150f0d277b8d..9c454bf82904655e5d12cd87d8c23c795f82e17d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/typebound_call_24.f03 b/gcc/testsuite/gfortran.dg/typebound_call_24.f03
new file mode 100644 (file)
index 0000000..48d63dc
--- /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 <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" } }