This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[4.5, Patch, Fortran] Run-time check for recursion
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Sat, 6 Dec 2008 13:14:57 +0100
- Subject: [4.5, Patch, Fortran] Run-time check for recursion
Hi all,
the following adds a run-time check for calling a procedure recursively
without without marking it as RECURSIVE. It relies on Paul's/FX's memory
patch, which add the needed option. (I'm also not documenting it, hoping
that the other patch will also adding the needed documentation.)
Daniel, I hope you have not yet started implementing this, but I needed
yesterday evening something which I could do productively.
Build and tested on x86-64-linux.
(Before check in, one should regtest it again after Paul/FX's patch is in.)
OK for 4.5?
Tobias
2008-12-06 Tobias Burnus <burnus@net-b.de>
PR fortran/32626
* trans-decl.c (gfc_generate_function_code): Add recursion check.
2008-12-06 Tobias Burnus <burnus@net-b.de>
PR fortran/32626
* gfortran.dg/recursive_check_7.f90: New test.
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 142519)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -3825,6 +3852,24 @@ gfc_generate_function_code (gfc_namespac
gfc_add_expr_to_block (&body, tmp);
}
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !sym->attr.recursive)
+ {
+ char * msg;
+ tree tmpvar;
+
+ asprintf (&msg, "Recursive call to nonrecursive procedure '%s'",
+ sym->name);
+
+ tmpvar = gfc_create_var (boolean_type_node, "is_recursive");
+ TREE_STATIC (tmpvar) = 1;
+ DECL_INITIAL (tmpvar) = boolean_false_node;
+ gfc_add_expr_to_block (&block, tmpvar);
+ gfc_trans_runtime_check (true, false, tmpvar, &block,
+ &sym->declared_at, msg);
+ gfc_add_modify (&block, tmpvar, boolean_true_node);
+ gfc_free (msg);
+ }
+
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
&& sym->attr.subroutine)
{
Index: gcc/testsuite/gfortran.dg/recursive_check_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/recursive_check_7.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/recursive_check_7.f90 (Revision 0)
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-fruntime-check=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! PR fortran/32626
+! Recursion run-time check
+!
+recursive subroutine valid(x)
+ logical :: x
+ if(x) call sndValid()
+ print *, 'OK'
+end subroutine valid
+
+subroutine sndValid()
+ call valid(.false.)
+end subroutine sndValid
+
+subroutine invalid(x)
+ logical :: x
+ if(x) call sndInvalid()
+ print *, 'BUG'
+ call abort()
+end subroutine invalid
+
+subroutine sndInvalid()
+ call invalid(.false.)
+end subroutine sndInvalid
+
+call valid(.true.)
+call invalid(.true.)
+end
+
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'invalid'" }