OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2009-04-04 23:38:12 +02:00 committed by Tobias Burnus
parent 862900112e
commit cf7d2eb033
10 changed files with 239 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

22
gcc/fortran/trans-decl.c
View File

@ -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);
/* Reset recursion-check variable. */
if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !sym->attr.recursive)
if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
{
gfc_add_modify (&block, recurcheckvar, boolean_false_node);
recurcheckvar = NULL;
}
}
/* Add all the decls we created during processing. */
decl = saved_function_decls;

11
gcc/testsuite/ChangeLog
View File

@ -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

25
gcc/testsuite/gfortran.dg/recursive_check_10.f90 Normal file
View File

@ -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

28
gcc/testsuite/gfortran.dg/recursive_check_11.f90 Normal file
View File

@ -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

29
gcc/testsuite/gfortran.dg/recursive_check_12.f90 Normal file
View File

@ -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" } }

32
gcc/testsuite/gfortran.dg/recursive_check_13.f90 Normal file
View File

@ -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" } }

40
gcc/testsuite/gfortran.dg/recursive_check_14.f90 Normal file
View File

@ -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

22
gcc/testsuite/gfortran.dg/recursive_check_8.f90 Normal file
View File

@ -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

25
gcc/testsuite/gfortran.dg/recursive_check_9.f90 Normal file
View File

@ -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