re PR fortran/32626 (Run-time check for recursive functions)

2009-03-28  Tobias Burnus  <burnus@net-b.de>

        PR fortran/32626
        * option.c (gfc_handle_runtime_check_option): Enable recursion check.
        * trans-decl.c (gfc_generate_function_code): Add recursion check.
        * invoke.texi (-fcheck): Add recursive option.

From-SVN: r145188

4 files changed, 36 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3bacc1..5373c9d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,12 @@
 2009-03-28  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/32626
+	* option.c (gfc_handle_runtime_check_option): Enable recursion check.
+	* trans-decl.c (gfc_generate_function_code): Add recursion check.
+	* invoke.texi (-fcheck): Add recursive option.
+
+2009-03-28  Tobias Burnus  <burnus@net-b.de>
+
 	PR fortran/38432
 	* resolve.c (gfc_resolve_iterator): Add zero-loop warning.
 
@@ -8,12 +15,12 @@
 	    Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.h (gfc_option_t): Add rtcheck.
-	* lang.opt: New option -fruntime-check.
+	* lang.opt: New option -fcheck.
 	* libgfortran.h: Add GFC_RTCHECK_* constants.
-	* invoke.texi: Document -fruntime-check.
+	* invoke.texi: Document -fcheck.
 	* options.c (gfc_handle_runtime_check_option): New function.
 	(gfc_init_options,gfc_post_options,gfc_handle_option):
-	Add -fruntime-check option.
+	Add -fcheck option.
 
 2009-03-27  Richard Guenther  <rguenther@suse.de>
 
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 87afe78..9eb5de1 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -1220,6 +1220,10 @@ the compilation of the main program.
 
 Note: In the future this may also include other forms of checking, e.g.,
 checking substring references.
+
+@item @samp{recursion}
+Enable generation of run-time checks for recursively called subroutines and
+functions which are not marked as recursive. See also @option{-frecursive}.
 @end table
 
 
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 5daa736..fd9fb88 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -458,10 +458,10 @@ gfc_handle_runtime_check_option (const char *arg)
 {
   int result, pos = 0, n;
   static const char * const optname[] = { "all", "bounds", "array-temps",
-					  /* "recursion", "do", */ NULL };
+					  "recursion", /* "do", */ NULL };
   static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
 				 GFC_RTCHECK_ARRAY_TEMPS,
-				 /* GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO, */
+				 GFC_RTCHECK_RECURSION, /* GFC_RTCHECK_DO, */
 				 0 };
  
   while (*arg)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d3895d8..6cfc86a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3679,6 +3679,7 @@ gfc_generate_function_code (gfc_namespace * ns)
   stmtblock_t block;
   stmtblock_t body;
   tree result;
+  tree recurcheckvar = NULL;
   gfc_symbol *sym;
   int rank;
 
@@ -3846,6 +3847,22 @@ gfc_generate_function_code (gfc_namespace * ns)
       gfc_add_expr_to_block (&body, tmp);
     }
 
+   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !sym->attr.recursive)
+     {
+       char * msg;
+
+       asprintf (&msg, "Recursive call to nonrecursive procedure '%s'",
+		 sym->name);
+       recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive");
+       TREE_STATIC (recurcheckvar) = 1;
+       DECL_INITIAL (recurcheckvar) = boolean_false_node;
+       gfc_add_expr_to_block (&block, recurcheckvar);
+       gfc_trans_runtime_check (true, false, recurcheckvar, &block,
+				&sym->declared_at, msg);
+       gfc_add_modify (&block, recurcheckvar, boolean_true_node);
+       gfc_free (msg);
+    }
+
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
       && sym->attr.subroutine)
     {
@@ -3924,6 +3941,9 @@ gfc_generate_function_code (gfc_namespace * ns)
   else
     gfc_add_expr_to_block (&block, tmp);
 
+ /* Reset recursion-check variable.  */
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !sym->attr.recursive)
+   gfc_add_modify (&block, recurcheckvar, boolean_false_node);
 
   /* Add all the decls we created during processing.  */
   decl = saved_function_decls;