diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 32 |
1 files changed, 25 insertions, 7 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2dcb261..b6277d2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8868,27 +8868,45 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) /* For variable targets, we get some attributes from the target. */ if (target->expr_type == EXPR_VARIABLE) { - gfc_symbol* tsym; + gfc_symbol *tsym, *dsym; gcc_assert (target->symtree); tsym = target->symtree->n.sym; - if (tsym->attr.subroutine - || tsym->attr.external - || (tsym->attr.function && tsym->result != tsym)) + if (gfc_expr_attr (target).proc_pointer) { - gfc_error ("Associating entity %qs at %L is a procedure name", + gfc_error ("Associating entity %qs at %L is a procedure pointer", tsym->name, &target->where); return; } - if (gfc_expr_attr (target).proc_pointer) + if (tsym->attr.flavor == FL_PROCEDURE && tsym->generic + && (dsym = gfc_find_dt_in_generic (tsym)) != NULL + && dsym->attr.flavor == FL_DERIVED) { - gfc_error ("Associating entity %qs at %L is a procedure pointer", + gfc_error ("Derived type %qs cannot be used as a variable at %L", tsym->name, &target->where); return; } + if (tsym->attr.flavor == FL_PROCEDURE) + { + bool is_error = true; + if (tsym->attr.function && tsym->result == tsym) + for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent) + if (tsym == ns->proc_name) + { + is_error = false; + break; + } + if (is_error) + { + gfc_error ("Associating entity %qs at %L is a procedure name", + tsym->name, &target->where); + return; + } + } + sym->attr.asynchronous = tsym->attr.asynchronous; sym->attr.volatile_ = tsym->attr.volatile_; |