diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 56 |
1 files changed, 30 insertions, 26 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 16661fd..9a95d34 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5082,7 +5082,7 @@ resolve_typebound_call (gfc_code* c) resolving subroutine class methods, since we do not have to add a gfc_code each time. */ static gfc_try -resolve_compcall (gfc_expr* e, bool fcn) +resolve_compcall (gfc_expr* e, bool fcn, bool class_members) { gfc_actual_arglist* newactual; gfc_symtree* target; @@ -5132,10 +5132,10 @@ resolve_compcall (gfc_expr* e, bool fcn) e->ts = target->n.sym->ts; e->expr_type = EXPR_FUNCTION; - /* Resolution is not necessary if this is a class subroutine; this - function only has to identify the specific proc. Resolution of - the call will be done next in resolve_typebound_call. */ - return fcn ? gfc_resolve_expr (e) : SUCCESS; + /* Resolution is not necessary when constructing component calls + for class members, since this must only be done for the + declared type, which is done afterwards. */ + return !class_members ? gfc_resolve_expr (e) : SUCCESS; } @@ -5147,7 +5147,6 @@ static gfc_expr *list_e; static void check_class_members (gfc_symbol *); static gfc_try class_try; static bool fcn_flag; -static gfc_symbol *class_object; static void @@ -5202,7 +5201,7 @@ check_class_members (gfc_symbol *derived) /* Do the renaming, PASSing, generic => specific and other good things for each class member. */ - class_try = (resolve_compcall (e, fcn_flag) == SUCCESS) + class_try = (resolve_compcall (e, fcn_flag, true) == SUCCESS) ? class_try : FAILURE; /* Now transfer the found symbol to the esym list. */ @@ -5337,9 +5336,13 @@ resolve_arg_exprs (gfc_actual_arglist *arg) } -/* Resolve a CLASS typebound function, or 'method'. */ +/* Resolve a typebound function, or 'method'. First separate all + the non-CLASS references by calling resolve_compcall directly. + Then treat the CLASS references by resolving for each of the class + members in turn. */ + static gfc_try -resolve_class_compcall (gfc_expr* e) +resolve_typebound_function (gfc_expr* e) { gfc_symbol *derived, *declared; gfc_ref *new_ref; @@ -5347,16 +5350,18 @@ resolve_class_compcall (gfc_expr* e) gfc_symtree *st; st = e->symtree; - class_object = st->n.sym; + if (st == NULL) + return resolve_compcall (e, true, false); /* Get the CLASS declared type. */ declared = get_declared_from_expr (&class_ref, &new_ref, e); /* Weed out cases of the ultimate component being a derived type. */ - if (class_ref && class_ref->u.c.component->ts.type == BT_DERIVED) + if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED) + || (!class_ref && st->n.sym->ts.type != BT_CLASS)) { gfc_free_ref_list (new_ref); - return resolve_compcall (e, true); + return resolve_compcall (e, true, false); } /* Resolve the argument expressions, */ @@ -5371,7 +5376,7 @@ resolve_class_compcall (gfc_expr* e) list_e = gfc_copy_expr (e); check_class_members (derived); - class_try = (resolve_compcall (e, true) == SUCCESS) + class_try = (resolve_compcall (e, true, false) == SUCCESS) ? class_try : FAILURE; /* Transfer the class list to the original expression. Note that @@ -5392,9 +5397,13 @@ resolve_class_compcall (gfc_expr* e) return class_try; } -/* Resolve a CLASS typebound subroutine, or 'method'. */ +/* Resolve a typebound subroutine, or 'method'. First separate all + the non-CLASS references by calling resolve_typebound_call directly. + Then treat the CLASS references by resolving for each of the class + members in turn. */ + static gfc_try -resolve_class_typebound_call (gfc_code *code) +resolve_typebound_subroutine (gfc_code *code) { gfc_symbol *derived, *declared; gfc_ref *new_ref; @@ -5402,13 +5411,15 @@ resolve_class_typebound_call (gfc_code *code) gfc_symtree *st; st = code->expr1->symtree; - class_object = st->n.sym; + if (st == NULL) + return resolve_typebound_call (code); /* Get the CLASS declared type. */ declared = get_declared_from_expr (&class_ref, &new_ref, code->expr1); /* Weed out cases of the ultimate component being a derived type. */ - if (class_ref && class_ref->u.c.component->ts.type == BT_DERIVED) + if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED) + || (!class_ref && st->n.sym->ts.type != BT_CLASS)) { gfc_free_ref_list (new_ref); return resolve_typebound_call (code); @@ -5584,10 +5595,7 @@ gfc_resolve_expr (gfc_expr *e) break; case EXPR_COMPCALL: - if (e->symtree && e->symtree->n.sym->ts.type == BT_CLASS) - t = resolve_class_compcall (e); - else - t = resolve_compcall (e, true); + t = resolve_typebound_function (e); break; case EXPR_SUBSTRING: @@ -8150,11 +8158,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_COMPCALL: compcall: - if (code->expr1->symtree - && code->expr1->symtree->n.sym->ts.type == BT_CLASS) - resolve_class_typebound_call (code); - else - resolve_typebound_call (code); + resolve_typebound_subroutine (code); break; case EXEC_CALL_PPC: |