continue;
}
- if (sym->ts.type == BT_UNKNOWN)
- {
- if (!sym->attr.function || sym->result == sym)
- gfc_set_default_type (sym, 1, sym->ns);
- }
+ if (sym->ts.type == BT_UNKNOWN && !proc->attr.intrinsic
+ && (!sym->attr.function || sym->result == sym))
+ gfc_set_default_type (sym, 1, sym->ns);
gfc_resolve_array_spec (sym->as, 0);
check_typebound_baseobject (gfc_expr* e)
{
gfc_expr* base;
+ gfc_try return_value = FAILURE;
base = extract_compcall_passed_object (e);
if (!base)
{
gfc_error ("Base object for type-bound procedure call at %L is of"
" ABSTRACT type '%s'", &e->where, base->ts.u.derived->name);
- return FAILURE;
+ goto cleanup;
}
/* If the procedure called is NOPASS, the base object must be scalar. */
{
gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
" be scalar", &e->where);
- return FAILURE;
+ goto cleanup;
}
/* FIXME: Remove once PR 41177 (this problem) is fixed completely. */
{
gfc_error ("Non-scalar base object at %L currently not implemented",
&e->where);
- return FAILURE;
+ goto cleanup;
}
- return SUCCESS;
+ return_value = SUCCESS;
+
+cleanup:
+ gfc_free_expr (base);
+ return return_value;
}
{
/* Set up default initializer if needed. */
gfc_typespec ts;
+ gfc_expr *init_e;
if (code->ext.alloc.ts.type == BT_DERIVED)
ts = code->ext.alloc.ts;
if (ts.type == BT_CLASS)
ts = ts.u.derived->components->ts;
- if (ts.type == BT_DERIVED && gfc_has_default_initializer(ts.u.derived))
+ if (ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&ts)))
{
- gfc_expr *init_e = gfc_default_initializer (&ts);
gfc_code *init_st = gfc_get_code ();
init_st->loc = code->loc;
init_st->op = EXEC_INIT_ASSIGN;
ts = &sym->ts;
/* Go to actual component transferred. */
- for (ref = code->expr1->ref; ref; ref = ref->next)
+ for (ref = exp->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
ts = &ref->u.c.component->ts;
for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
if (derived == dt_list->derived)
- break;
+ return;
- if (dt_list == NULL)
- {
- dt_list = gfc_get_dt_list ();
- dt_list->next = gfc_derived_types;
- dt_list->derived = derived;
- gfc_derived_types = dt_list;
- }
+ dt_list = gfc_get_dt_list ();
+ dt_list->next = gfc_derived_types;
+ dt_list->derived = derived;
+ gfc_derived_types = dt_list;
}