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