Skip to content

R
riscv-gcc-1
Commit cf7d2eb0 by Tobias Burnus Committed by Tobias Burnus
Options

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
parent 86290011
Showing with 239 additions and 5 deletions
gcc/fortran/ChangeLog
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
......
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;
......
gcc/testsuite/ChangeLog
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
......
gcc/testsuite/gfortran.dg/recursive_check_10.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/recursive_check_11.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/recursive_check_12.f90 0 → 100644
! { 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" } }
gcc/testsuite/gfortran.dg/recursive_check_13.f90 0 → 100644
! { 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" } }
gcc/testsuite/gfortran.dg/recursive_check_14.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/recursive_check_8.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/recursive_check_9.f90 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment