[Bug fortran/59493] [OOP] ICE: Segfault on Class(*) pointer association

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=59493

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |ASSIGNED
           Assignee|unassigned at gcc dot gnu.org      |janus at gcc dot gnu.org

--- Comment #4 from janus at gcc dot gnu.org ---
(In reply to Hossein Talebi from comment #3)
> Will it be fixed in gfortran 4.8 or 4.9?

Since I already found out what goes wrong, it will pretty certainly get fixed
on the trunk (to-be-4.9) soon. Since it is not a regression, probably no
backporting to 4.8 will be done.

In any case: The problem was that 'gfc_find_intrinsic_vtab' failed to handle
BT_CLASS. The following patch fixes it (and does some minor cleanup):

Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c    (revision 205948)
+++ gcc/fortran/class.c    (working copy)
@@ -2413,29 +2413,34 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
   gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
   int charlen = 0;

-  if (ts->type == BT_CHARACTER && ts->deferred)
+  switch (ts->type)
     {
-      gfc_error ("TODO: Deferred character length variable at %C cannot "
-         "yet be associated with unlimited polymorphic entities");
+    case BT_UNKNOWN:
       return NULL;
+    case BT_DERIVED:
+      return gfc_find_derived_vtab (ts->u.derived);
+    case BT_CLASS:
+      return gfc_find_derived_vtab (ts->u.derived->components->ts.u.derived);
+    case (BT_CHARACTER):
+      if (ts->deferred)
+    {
+      gfc_error ("TODO: Deferred character length variable at %C cannot "
+            "yet be associated with unlimited polymorphic entities");
+      return NULL;
+    }
+      else if (ts->u.cl && ts->u.cl->length
+           && ts->u.cl->length->expr_type == EXPR_CONSTANT)
+    charlen = mpz_get_si (ts->u.cl->length->value.integer);
+      break;
+    default:
+      break;
     }

-  if (ts->type == BT_UNKNOWN)
-    return NULL;
-
-  /* Sometimes the typespec is passed from a single call.  */
-  if (ts->type == BT_DERIVED)
-    return gfc_find_derived_vtab (ts->u.derived);
-
   /* Find the top-level namespace.  */
   for (ns = gfc_current_ns; ns; ns = ns->parent)
     if (!ns->parent)
       break;

-  if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length
-      && ts->u.cl->length->expr_type == EXPR_CONSTANT)
-    charlen = mpz_get_si (ts->u.cl->length->value.integer);
-
   if (ns)
     {
       char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];