From cf7d2eb033c2f79821b48f38a640f2b77845e4d5 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 4 Apr 2009 23:38:12 +0200 Subject: [PATCH] re PR fortran/39577 (False positive with -fcheck=recursion) 2009-04-04 Tobias Burnus PR fortran/39577 * trans-decl.c (gfc_generate_function_code): Move recursive check to the right position. 2009-04-04 Tobias Burnus 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 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-decl.c | 26 +++++++++--- gcc/testsuite/ChangeLog | 11 +++++ .../gfortran.dg/recursive_check_10.f90 | 25 ++++++++++++ .../gfortran.dg/recursive_check_11.f90 | 28 +++++++++++++ .../gfortran.dg/recursive_check_12.f90 | 29 ++++++++++++++ .../gfortran.dg/recursive_check_13.f90 | 32 +++++++++++++++ .../gfortran.dg/recursive_check_14.f90 | 40 +++++++++++++++++++ .../gfortran.dg/recursive_check_8.f90 | 22 ++++++++++ .../gfortran.dg/recursive_check_9.f90 | 25 ++++++++++++ 10 files changed, 239 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_11.f90 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_12.f90 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_13.f90 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_14.f90 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_8.f90 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2f611ff6d5f1..d1c823a85775 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-04-04 Tobias Burnus + + PR fortran/39577 + * trans-decl.c (gfc_generate_function_code): Move recursive + check to the right position. + 2009-04-04 Paul Thomas PR fortran/37614 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 774f42078da7..ac768b3a0016 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 57947f5ad657..1f090d0616d1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2009-04-04 Tobias Burnus + + 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 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 000000000000..a30b82caaf26 --- /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 000000000000..870c1127d012 --- /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 000000000000..22eaf7d0f282 --- /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 000000000000..ed222a322ec5 --- /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 000000000000..e68e5fc566b1 --- /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 000000000000..4d83498c7e24 --- /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 000000000000..50af06787fc9 --- /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 -- 2.43.5