diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e3bacc1aa0f6..5373c9df08eb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2009-03-28 Tobias Burnus + + 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 PR fortran/38432 @@ -8,12 +15,12 @@ Tobias Burnus * 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 diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 87afe783d6b4..9eb5de1a05c9 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -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 diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 5daa73625044..fd9fb880d83c 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -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) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index d3895d8cef00..6cfc86a4bb7d 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 315f6cfc06ff..aba092f9695f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,9 @@ -2009-03-28 Tobias Burnus +2009-03-28 Tobias Burnus + + PR fortran/32626 + * gfortran.dg/recursive_check_7.f90: New test. + +2009-03-28 Tobias Burnus PR fortran/38432 * gfortran.dg/do_check_5.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/recursive_check_7.f90 b/gcc/testsuite/gfortran.dg/recursive_check_7.f90 new file mode 100644 index 000000000000..c1af8adc8102 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/recursive_check_7.f90 @@ -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'" }