diff options
author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2006-05-17 16:11:40 +0200 |
---|---|---|
committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-05-17 14:11:40 +0000 |
commit | 77f131ca20f4394c1d333fe2cc37533177238d00 (patch) | |
tree | 95d49920a92d86be58e80e3f3c5df27263b61e48 /gcc | |
parent | be448346aa660311b2cb932c082b101bc1cf504b (diff) | |
download | gcc-77f131ca20f4394c1d333fe2cc37533177238d00.zip gcc-77f131ca20f4394c1d333fe2cc37533177238d00.tar.gz gcc-77f131ca20f4394c1d333fe2cc37533177238d00.tar.bz2 |
re PR fortran/26551 (gfortran compiles recursive subroutines declared without the RECURSIVE attribute)
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.
From-SVN: r113860
Diffstat (limited to 'gcc')
-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 547a85f..1f30fd4 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 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++; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bc6e789..3a82938 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 0000000..b264f25 --- /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 |