diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7020491..f106d05 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1380,6 +1380,30 @@ resolve_function (gfc_expr * expr) } } + /* Functions without the RECURSIVE attribution are not allowed to + * call themselves. */ + if (expr->value.function.esym && !expr->value.function.esym->attr.recursive) + { + gfc_symbol *esym, *proc; + esym = expr->value.function.esym; + proc = gfc_current_ns->proc_name; + if (esym == proc) + { + gfc_error ("Function '%s' at %L cannot call itself, as it is not " + "RECURSIVE", name, &expr->where); + t = FAILURE; + } + + if (esym->attr.entry && esym->ns->entries && proc->ns->entries + && esym->ns->entries->sym == proc->ns->entries->sym) + { + gfc_error ("Call to ENTRY '%s' at %L is recursive, but function " + "'%s' is not declared as RECURSIVE", + esym->name, &expr->where, esym->ns->entries->sym->name); + t = FAILURE; + } + } + /* Character lengths of use associated functions may contains references to symbols not referenced from the current program unit otherwise. Make sure those symbols are marked as referenced. */ @@ -1629,6 +1653,30 @@ resolve_call (gfc_code * c) && !c->symtree->n.sym->attr.use_assoc) resolve_global_procedure (c->symtree->n.sym, &c->loc, 1); + /* Subroutines without the RECURSIVE attribution are not allowed to + * call themselves. */ + if (c->symtree && c->symtree->n.sym && !c->symtree->n.sym->attr.recursive) + { + gfc_symbol *csym, *proc; + csym = c->symtree->n.sym; + proc = gfc_current_ns->proc_name; + if (csym == proc) + { + gfc_error ("SUBROUTINE '%s' at %L cannot call itself, as it is not " + "RECURSIVE", csym->name, &c->loc); + t = FAILURE; + } + + if (csym->attr.entry && csym->ns->entries && proc->ns->entries + && csym->ns->entries->sym == proc->ns->entries->sym) + { + gfc_error ("Call to ENTRY '%s' at %L is recursive, but subroutine " + "'%s' is not declared as RECURSIVE", + csym->name, &c->loc, csym->ns->entries->sym->name); + t = FAILURE; + } + } + /* Switch off assumed size checking and do this again for certain kinds of procedure, once the procedure itself is resolved. */ need_full_assumed_size++; |
