From 77f131ca20f4394c1d333fe2cc37533177238d00 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Wed, 17 May 2006 16:11:40 +0200 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 13 ++++++++ gcc/fortran/resolve.c | 48 +++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/recursive_check_1.f | 27 +++++++++++++++ 4 files changed, 93 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_1.f 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 + 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 + + PR fortran/26551 + * gfortran.dg/recursive_check_1.f: New test. + + +2006-05-17 Francois-Xavier Coudert + 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 + + PR fortran/26551 + * gfortran.dg/recursive_check_1.f: New test. + 2005-05-17 Bernd Schmidt * 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 -- 2.7.4