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

gcc/fortran/ChangeLog

 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>
 

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
 
 

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)

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;

gcc/testsuite/ChangeLog

-2009-03-28 Tobias Burnus  <burnus@net-b.de>
+2009-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32626
+	* gfortran.dg/recursive_check_7.f90: New test.
+
+2009-03-28  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/38432
 	* gfortran.dg/do_check_5.f90: New test.

gcc/testsuite/gfortran.dg/recursive_check_7.f90

+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! PR fortran/32626
+! Recursion run-time check
+!
+
+subroutine NormalFunc()
+end subroutine NormalFunc
+
+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 valid(.true.)
+call NormalFunc()
+call NormalFunc()
+call invalid(.true.)
+end
+
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'invalid'" }