From: Daniel Kraft Date: Mon, 24 Nov 2008 13:10:37 +0000 (+0100) Subject: re PR fortran/37779 (Missing RECURSIVE not detected) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a03826d1d56e819d6e6d0bd2ce96d96a931dc370;p=gcc.git re PR fortran/37779 (Missing RECURSIVE not detected) 2008-11-24 Daniel Kraft PR fortran/37779 * resolve.c (resolve_procedure_expression): New method. (resolve_variable): Call it. (resolve_actual_arglist): Call gfc_resolve_expr for procedure arguments. 2008-11-24 Daniel Kraft PR fortran/37779 * gfortran.dg/c_funloc_tests.f03: Added missing `RECURSIVE'. * gfortran.dg/c_funloc_tests_2.f03: Ditto. * gfortran.dg/recursive_check_4.f03: New test. * gfortran.dg/recursive_check_5.f03: New test. From-SVN: r142158 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5f55609e6ca..8a0092175ee 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-11-24 Daniel Kraft + + PR fortran/37779 + * resolve.c (resolve_procedure_expression): New method. + (resolve_variable): Call it. + (resolve_actual_arglist): Call gfc_resolve_expr for procedure arguments. + 2008-11-24 Paul Thomas PR fortran/34820 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0f0644f0d83..f1c27e62b59 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1072,6 +1072,33 @@ count_specific_procs (gfc_expr *e) return n; } + +/* Resolve a procedure expression, like passing it to a called procedure or as + RHS for a procedure pointer assignment. */ + +static gfc_try +resolve_procedure_expression (gfc_expr* expr) +{ + gfc_symbol* sym; + + if (expr->ts.type != BT_PROCEDURE || expr->expr_type != EXPR_VARIABLE) + return SUCCESS; + gcc_assert (expr->symtree); + sym = expr->symtree->n.sym; + gcc_assert (sym->attr.flavor == FL_PROCEDURE); + + /* A non-RECURSIVE procedure that is used as procedure expression within its + own body is in danger of being called recursively. */ + if (!sym->attr.recursive && sym == gfc_current_ns->proc_name + && !gfc_option.flag_recursive) + gfc_warning ("Non-RECURSIVE procedure '%s' at %L is possibly calling" + " itself recursively. Declare it RECURSIVE or use" + " -frecursive", sym->name, &expr->where); + + return SUCCESS; +} + + /* Resolve an actual argument list. Most of the time, this is just resolving the expressions in the list. The exception is that we sometimes have to decide whether arguments @@ -1180,8 +1207,8 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, && sym->ns == gfc_current_ns && !sym->ns->entries->sym->attr.recursive) { - gfc_error ("Reference to ENTRY '%s' at %L is recursive, but procedure " - "'%s' is not declared as RECURSIVE", + gfc_error ("Reference to ENTRY '%s' at %L is recursive, but" + " procedure '%s' is not declared as RECURSIVE", sym->name, &e->where, sym->ns->entries->sym->name); } @@ -1211,6 +1238,9 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, sym->attr.intrinsic = 1; sym->attr.function = 1; } + + if (gfc_resolve_expr (e) == FAILURE) + return FAILURE; goto argument_list; } @@ -1235,6 +1265,8 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, || sym->attr.intrinsic || sym->attr.external) { + if (gfc_resolve_expr (e) == FAILURE) + return FAILURE; goto argument_list; } @@ -4155,7 +4187,7 @@ resolve_variable (gfc_expr *e) if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function) { e->ts.type = BT_PROCEDURE; - return SUCCESS; + goto resolve_procedure; } if (sym->ts.type != BT_UNKNOWN) @@ -4237,6 +4269,10 @@ resolve_variable (gfc_expr *e) sym->entry_id = current_entry_id + 1; } +resolve_procedure: + if (t == SUCCESS && resolve_procedure_expression (e) == FAILURE) + t = FAILURE; + return t; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 734759df2a5..d66b4eba18c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2008-11-24 Daniel Kraft + + PR fortran/37779 + * gfortran.dg/c_funloc_tests.f03: Added missing `RECURSIVE'. + * gfortran.dg/c_funloc_tests_2.f03: Ditto. + * gfortran.dg/recursive_check_4.f03: New test. + * gfortran.dg/recursive_check_5.f03: New test. + 2008-11-24 Mikael Morin PR fortran/35681 diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests.f03 index c34ef2b6f49..8ba07b9fbba 100644 --- a/gcc/testsuite/gfortran.dg/c_funloc_tests.f03 +++ b/gcc/testsuite/gfortran.dg/c_funloc_tests.f03 @@ -5,7 +5,7 @@ module c_funloc_tests use, intrinsic :: iso_c_binding, only: c_funptr, c_funloc contains - subroutine sub0() bind(c) + recursive subroutine sub0() bind(c) type(c_funptr) :: my_c_funptr my_c_funptr = c_funloc(sub0) diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03 index afaf29fc896..d3ed265ea8c 100644 --- a/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03 +++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03 @@ -4,7 +4,7 @@ module c_funloc_tests_2 implicit none contains - subroutine sub0() bind(c) + recursive subroutine sub0() bind(c) type(c_funptr) :: my_c_funptr integer :: my_local_variable diff --git a/gcc/testsuite/gfortran.dg/recursive_check_4.f03 b/gcc/testsuite/gfortran.dg/recursive_check_4.f03 new file mode 100644 index 00000000000..2a95554ff25 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/recursive_check_4.f03 @@ -0,0 +1,26 @@ +! { dg-do compile } + +! PR fortran/37779 +! Check that using a non-recursive procedure as "value" is an error. + +MODULE m + IMPLICIT NONE + +CONTAINS + + SUBROUTINE test () + IMPLICIT NONE + PROCEDURE(test), POINTER :: procptr + + CALL bar (test) ! { dg-warning "Non-RECURSIVE" } + procptr => test ! { dg-warning "Non-RECURSIVE" } + END SUBROUTINE test + + INTEGER FUNCTION func () + ! Using a result variable is ok of course! + func = 42 ! { dg-bogus "Non-RECURSIVE" } + END FUNCTION func + +END MODULE m + +! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/recursive_check_5.f03 b/gcc/testsuite/gfortran.dg/recursive_check_5.f03 new file mode 100644 index 00000000000..4014986b3b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/recursive_check_5.f03 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-options "-frecursive" } + +! PR fortran/37779 +! Check that -frecursive allows using procedures in as procedure expressions. + +MODULE m + IMPLICIT NONE + +CONTAINS + + SUBROUTINE test () + IMPLICIT NONE + PROCEDURE(test), POINTER :: procptr + + CALL bar (test) ! { dg-bogus "Non-RECURSIVE" } + procptr => test ! { dg-bogus "Non-RECURSIVE" } + END SUBROUTINE test + + INTEGER FUNCTION func () + ! Using a result variable is ok of course! + func = 42 ! { dg-bogus "Non-RECURSIVE" } + END FUNCTION func + +END MODULE m + +! { dg-final { cleanup-modules "m" } }