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];
