diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e4ea10f..2093de9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -566,6 +566,14 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) { bool t; + if (sym && sym->attr.flavor == FL_PROCEDURE + && sym->ns->parent + && sym->ns->parent->proc_name + && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE + && !strcmp (sym->name, sym->ns->parent->proc_name->name)) + gfc_error ("Contained procedure %qs at %L has the same name as its " + "encompassing procedure", sym->name, &sym->declared_at); + /* If this namespace is not a function or an entry master function, ignore it. */ if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE) @@ -15747,6 +15755,54 @@ resolve_equivalence (gfc_equiv *eq) } +/* Function called by resolve_fntype to flag other symbol used in the + length type parameter specification of function resuls. */ + +static bool +flag_fn_result_spec (gfc_expr *expr, + gfc_symbol *sym ATTRIBUTE_UNUSED, + int *f ATTRIBUTE_UNUSED) +{ + gfc_namespace *ns; + gfc_symbol *s; + + if (expr->expr_type == EXPR_VARIABLE) + { + s = expr->symtree->n.sym; + for (ns = s->ns; ns; ns = ns->parent) + if (!ns->parent) + break; + + if (!s->fn_result_spec + && s->attr.flavor == FL_PARAMETER) + { + /* Function contained in a module.... */ + if (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE) + { + gfc_symtree *st; + s->fn_result_spec = 1; + /* Make sure that this symbol is translated as a module + variable. */ + st = gfc_get_unique_symtree (ns); + st->n.sym = s; + s->refs++; + } + /* ... which is use associated and called. */ + else if (s->attr.use_assoc || s->attr.used_in_submodule + || + /* External function matched with an interface. */ + (s->ns->proc_name + && ((s->ns == ns + && s->ns->proc_name->attr.if_source == IFSRC_DECL) + || s->ns->proc_name->attr.if_source == IFSRC_IFBODY) + && s->ns->proc_name->attr.function)) + s->fn_result_spec = 1; + } + } + return false; +} + + /* Resolve function and ENTRY types, issue diagnostics if needed. */ static void @@ -15797,6 +15853,9 @@ resolve_fntype (gfc_namespace *ns) el->sym->attr.untyped = 1; } } + + if (sym->ts.type == BT_CHARACTER) + gfc_traverse_expr (sym->ts.u.cl->length, NULL, flag_fn_result_spec, 0); } |