mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-25 22:16:05 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/32626 (Run-time check for recursive functions)

Browse Source 
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
This commit is contained in:
Tobias Burnus 2009-03-28 15:04:14 +01:00
parent dc186969b5
commit 43998ed92e
6 changed files with 82 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
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
@ -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>

4
gcc/fortran/invoke.texi
View File

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

4
gcc/fortran/options.c
View File

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

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

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

7
gcc/testsuite/ChangeLog
View File

@ -1,4 +1,9 @@
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.

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

@ -0,0 +1,40 @@
! { 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'" }