[Patch, Fortran] PR 55983: [4.7/4.8 Regression] ICE in find_typebound_proc_uop, at fortran/class.c:2711

[Janus Weil <janus@gcc.gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 576 bytes --]

Hi all,

here is a close-to-obvious patch for an ICE-on-invalid regression. It
removes as assert, which is reasonable for valid code but can fail
under error conditions (as the PR shows), and replaces it with an
equivalent IF clause.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk and 4.7?

Cheers,
Janus


2013-01-16  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/55983
    * class.c (find_typebound_proc_uop): Check for f2k_derived instead of
    asserting it.


2013-01-16  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/55983
    * gfortran.dg/class_55.f90: New.

[-- Attachment #2: pr55983.diff --]
[-- Type: application/octet-stream, Size: 865 bytes --]

Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 195125)
+++ gcc/fortran/class.c	(working copy)
@@ -2707,15 +2707,17 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_
   gfc_symtree* res;
   gfc_symtree* root;
 
-  /* Set correct symbol-root.  */
-  gcc_assert (derived->f2k_derived);
-  root = (uop ? derived->f2k_derived->tb_uop_root
-	      : derived->f2k_derived->tb_sym_root);
-
   /* Set default to failure.  */
   if (t)
     *t = FAILURE;
 
+  if (derived->f2k_derived)
+    /* Set correct symbol-root.  */
+    root = (uop ? derived->f2k_derived->tb_uop_root
+		: derived->f2k_derived->tb_sym_root);
+  else
+    return NULL;
+
   /* Try to find it in the current type's namespace.  */
   res = gfc_find_symtree (root, name);
   if (res && res->n.tb && !res->n.tb->error)

[-- Attachment #3: class_55.f90 --]
[-- Type: application/octet-stream, Size: 417 bytes --]

! { dg-do compile }
!
! PR 55983: [4.7/4.8 Regression] ICE in find_typebound_proc_uop, at fortran/class.c:2711
!
! Contributed by Sylwester Arabas <slayoo@staszic.waw.pl>

  type :: mpdata_t
    class(bcd_t), pointer :: bcx, bcy   ! { dg-error "is a type that has not been declared" }
  end type
  type(mpdata_t) :: this
  call this%bcx%fill_halos()            ! { dg-error "is being used before it is defined" }
end