re PR fortran/39577 (False positive with -fcheck=recursion)

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

        PR fortran/39577
        * trans-decl.c (gfc_generate_function_code): Move recursive
        check to the right position.

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

        PR fortran/39577
        * gfortran.dg/recursive_check_8.f90: New.
        * gfortran.dg/recursive_check_9.f90: New.
        * gfortran.dg/recursive_check_10.f90: New.
        * gfortran.dg/recursive_check_11.f90: New.
        * gfortran.dg/recursive_check_12.f90: New.
        * gfortran.dg/recursive_check_13.f90: New.
        * gfortran.dg/recursive_check_14.f90: New.

From-SVN: r145552

10 files changed, 239 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2f611ff..d1c823a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-04-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39577
+	* trans-decl.c (gfc_generate_function_code): Move recursive
+	check to the right position.
+
 2009-04-04  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/37614
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 774f420..ac768b3 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3718,6 +3718,7 @@ gfc_generate_function_code (gfc_namespace * ns)
   tree recurcheckvar = NULL;
   gfc_symbol *sym;
   int rank;
+  bool is_recursive;
 
   sym = ns->proc_name;
 
@@ -3883,7 +3884,10 @@ gfc_generate_function_code (gfc_namespace * ns)
       gfc_add_expr_to_block (&body, tmp);
     }
 
-   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !sym->attr.recursive)
+   is_recursive = sym->attr.recursive
+		  || (sym->attr.entry_master
+		      && sym->ns->entries->sym->attr.recursive);
+   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
      {
        char * msg;
 
@@ -3953,6 +3957,13 @@ gfc_generate_function_code (gfc_namespace * ns)
 
       gfc_add_expr_to_block (&block, tmp);
 
+      /* Reset recursion-check variable.  */
+      if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
+      {
+	gfc_add_modify (&block, recurcheckvar, boolean_false_node);
+	recurcheckvar = NULL;
+      }
+
       if (result == NULL_TREE)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
@@ -3975,11 +3986,16 @@ gfc_generate_function_code (gfc_namespace * ns)
 	}
     }
   else
-    gfc_add_expr_to_block (&block, tmp);
+    {
+      gfc_add_expr_to_block (&block, tmp);
+      /* Reset recursion-check variable.  */
+      if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
+      {
+	gfc_add_modify (&block, recurcheckvar, boolean_false_node);
+	recurcheckvar = NULL;
+      }
+    }
 
- /* 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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 57947f5..1f090d0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2009-04-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39577
+	* gfortran.dg/recursive_check_8.f90: New.
+	* gfortran.dg/recursive_check_9.f90: New.
+	* gfortran.dg/recursive_check_10.f90: New.
+	* gfortran.dg/recursive_check_11.f90: New.
+	* gfortran.dg/recursive_check_12.f90: New.
+	* gfortran.dg/recursive_check_13.f90: New.
+	* gfortran.dg/recursive_check_14.f90: New.
+
 2009-04-04  Jason Merrill  <jason@redhat.com>
 
 	PR c++/25185
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_10.f90 b/gcc/testsuite/gfortran.dg/recursive_check_10.f90
new file mode 100644
index 0000000..a30b82c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_10.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! OK - no recursion
+program test
+ integer :: i
+ i = f(.false.)
+ print *,i
+ i = f(.false.)
+ print *,i
+contains
+  integer function f(rec) 
+    logical :: rec
+    if(rec) then
+      f = g()
+    else
+      f = 42
+    end if
+  end function f
+  integer function g()
+    g = f(.false.)
+  end function g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_11.f90 b/gcc/testsuite/gfortran.dg/recursive_check_11.f90
new file mode 100644
index 0000000..870c112
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_11.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'f'" }
+!
+! PR fortran/39577
+!
+! wrong - recursion
+program test
+ integer :: i
+ i = f(.false.)
+ print *,i
+ i = f(.true.)
+ print *,i
+contains
+  integer function f(rec) 
+    logical :: rec
+    if(rec) then
+      f = g()
+    else
+      f = 42
+    end if
+  end function f
+  integer function g()
+    g = f(.false.)
+  end function g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_12.f90 b/gcc/testsuite/gfortran.dg/recursive_check_12.f90
new file mode 100644
index 0000000..22eaf7d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_12.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! OK - no recursion
+module m
+  implicit none
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call h()
+    end if
+    return
+  entry g()
+  end subroutine f
+  subroutine h()
+    call f(.false.)
+  end subroutine h
+end module m
+
+program test
+ use m
+ implicit none
+ call f(.false.)
+ call f(.false.)
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_13.f90 b/gcc/testsuite/gfortran.dg/recursive_check_13.f90
new file mode 100644
index 0000000..ed222a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_13.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'master.0.f'" }
+!
+! PR fortran/39577
+!
+! invalid - recursion
+module m
+  implicit none
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call h()
+    end if
+    return
+  entry g()
+  end subroutine f
+  subroutine h()
+    call f(.false.)
+  end subroutine h
+end module m
+
+program test
+ use m
+ implicit none
+ call f(.false.)
+ call f(.true.)
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_14.f90 b/gcc/testsuite/gfortran.dg/recursive_check_14.f90
new file mode 100644
index 0000000..e68e5fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_14.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! Recursive but valid program
+! Contributed by Dominique Dhumieres
+!
+recursive function fac(i) result (res)
+  integer :: i, j, k, res
+  k = 1
+  goto 100
+entry bifac(i,j) result (res)
+  k = j
+100 continue
+  if (i < k) then
+    res = 1
+  else
+    res = i * bifac(i-k,k)
+  end if
+end function
+
+program test
+interface
+  recursive function fac(n) result (res)
+    integer :: res
+    integer :: n
+  end function fac
+  recursive function bifac(m,n) result (res)
+    integer :: m, n, res
+  end function  bifac
+end interface
+
+  print *, fac(5)
+  print *, bifac(5,2)
+  print*, fac(6)
+  print *, bifac(6,2)
+  print*, fac(0)
+  print *, bifac(1,2)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_8.f90 b/gcc/testsuite/gfortran.dg/recursive_check_8.f90
new file mode 100644
index 0000000..4d83498
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_8.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! OK - no recursion
+program test
+ call f(.false.)
+ call f(.false.)
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call g()
+    end if
+    return
+  end subroutine f
+  subroutine g()
+    call f(.false.)
+    return
+  end subroutine g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_9.f90 b/gcc/testsuite/gfortran.dg/recursive_check_9.f90
new file mode 100644
index 0000000..50af067
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_9.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'f'" }
+!
+! PR fortran/39577
+!
+! Invalid - recursion
+program test
+ call f(.false.)
+ call f(.true.)
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call g()
+    end if
+    return
+  end subroutine f
+  subroutine g()
+    call f(.false.)
+    return
+  end subroutine g
+end program test