diff options
| author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-05-17 14:11:40 +0000 |
|---|---|---|
| committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-05-17 14:11:40 +0000 |
| commit | ff9cd459b433d278f998ea2b35f9419ee616ae30 (patch) | |
| tree | 95d49920a92d86be58e80e3f3c5df27263b61e48 | |
| parent | 4a62cbb143dd880f1b878aca4ae3edb242a93e32 (diff) | |
| download | ppe42-gcc-ff9cd459b433d278f998ea2b35f9419ee616ae30.tar.gz ppe42-gcc-ff9cd459b433d278f998ea2b35f9419ee616ae30.zip | |
PR fortran/26551
* resolve.c (resolve_call, resolve_function): Issue an error
if a function or subroutine call is recursive but the function or
subroutine wasn't declared as such.
* gfortran.dg/recursive_check_1.f: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@113860 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 48 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/recursive_check_1.f | 27 |
4 files changed, 93 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 547a85f5bae..1f30fd46a94 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,18 @@ 2006-05-17 Francois-Xavier Coudert <coudert@clipper.ens.fr> + PR fortran/26551 + * resolve.c (resolve_call, resolve_function): Issue an error + if a function or subroutine call is recursive but the function or + subroutine wasn't declared as such. + +2006-05-07 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + PR fortran/26551 + * gfortran.dg/recursive_check_1.f: New test. + + +2006-05-17 Francois-Xavier Coudert <coudert@clipper.ens.fr> + PR fortran/27320 * dump-parse-tree.c (gfc_show_code_node): Try harder to find the called procedure name. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7020491fafb..f106d053f76 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++; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bc6e789bf51..3a82938e079 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-05-17 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + PR fortran/26551 + * gfortran.dg/recursive_check_1.f: New test. + 2005-05-17 Bernd Schmidt <bernd.schmidt@analog.com> * g++.dg/opt/temp2.C: New test. diff --git a/gcc/testsuite/gfortran.dg/recursive_check_1.f b/gcc/testsuite/gfortran.dg/recursive_check_1.f new file mode 100644 index 00000000000..b264f25db76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/recursive_check_1.f @@ -0,0 +1,27 @@ +! { dg-do compile } +! PR fortran/26551 + SUBROUTINE SUB() + CALL SUB() ! { dg-error "cannot call itself, as it is not RECURSIVE" } + END SUBROUTINE + + FUNCTION FUNC() RESULT (FOO) + INTEGER FOO + FOO = FUNC() ! { dg-error "cannot call itself, as it is not RECURSIVE" } + END FUNCTION + + SUBROUTINE SUB2() + ENTRY ENT2() + CALL ENT2() ! { dg-error "is not declared as RECURSIVE" } + END SUBROUTINE + + function func2() + integer func2 + func2 = 42 + return + entry c() result (foo) + foo = b() ! { dg-error "is not declared as RECURSIVE" } + return + entry b() result (bar) + bar = 12 + return + end function |

