/* Implementation of Fortran 2003 Polymorphism.
- Copyright (C) 2009-2019 Free Software Foundation, Inc.
+ Copyright (C) 2009-2020 Free Software Foundation, Inc.
Contributed by Paul Richard Thomas <pault@gcc.gnu.org>
and Janus Weil <janus@gcc.gnu.org>
ref to the _len component. */
gfc_expr *
-gfc_get_len_component (gfc_expr *e)
+gfc_get_len_component (gfc_expr *e, int k)
{
gfc_expr *ptr;
gfc_ref *ref, **last;
}
/* And replace if with a ref to the _len component. */
gfc_add_len_component (ptr);
+ if (k != ptr->ts.kind)
+ {
+ gfc_typespec ts;
+ gfc_clear_ts (&ts);
+ ts.type = BT_INTEGER;
+ ts.kind = k;
+ gfc_convert_type_warn (ptr, &ts, 2, 0);
+ }
return ptr;
}
|| attr->select_type_temporary || attr->associate_var;
if (!attr->class_ok)
- /* We can not build the class container yet. */
+ /* We cannot build the class container yet. */
return true;
/* Determine the name of the encapsulating type. */
if (!comp_is_finalizable (comp))
return;
+ if (comp->finalized)
+ return;
+
e = gfc_copy_expr (expr);
if (!e->ref)
e->ref = ref = gfc_get_ref ();
sub_ns);
gfc_free_expr (e);
}
+ comp->finalized = true;
}
if (!derived->attr.unlimited_polymorphic && derived->attr.is_class)
derived = gfc_get_derived_super_type (derived);
+ if (!derived)
+ return NULL;
+
/* Find the gsymbol for the module of use associated derived types. */
if ((derived->attr.use_assoc || derived->attr.used_in_submodule)
&& !derived->attr.vtype && !derived->attr.is_class)
gfc_namespace *sub_ns;
gfc_namespace *contained;
gfc_expr *e;
+ size_t e_size;
gfc_get_symbol (name, ns, &vtype);
if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL,
e = gfc_get_expr ();
e->ts = *ts;
e->expr_type = EXPR_VARIABLE;
+ if (ts->type == BT_CHARACTER)
+ e_size = ts->kind;
+ else
+ gfc_element_size (e, &e_size);
c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL,
- ts->type == BT_CHARACTER
- ? ts->kind
- : gfc_element_size (e));
+ e_size);
gfc_free_expr (e);
/* Add component _extends. */
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);
+ if (ts->u.derived->components && ts->u.derived->components->ts.u.derived)
+ return gfc_find_derived_vtab (ts->u.derived->components->ts.u.derived);
+ else
+ return NULL;
default:
return find_intrinsic_vtab (ts);
}