This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, Fortran] RFC: PR fortran/37779, diagnose "missing" recursive


Hi,

I've attached a new version of the patch described below. This changes the error to a warning and also only warns for -fno-recursive (that is, -frecursive not given), as discussed a little on IRC. See the two tests for details if you are interested...

Will regression test this one, too. Ok for trunk if no failures?

Cheers,
Daniel

Daniel Kraft wrote:
attached is my proposed solution for PR 37779; the PR is about programs like this:

SUBROUTINE foo ()
  CALL bar (foo)
  procptr => foo
END SUBROUTINE foo

Where a *non-RECURSIVE* procedure is used as "procedure expression" and could thus lead easily to being called recursively. In the PR is referenced a clf-thread, where it seems to be not agreed upon whether this code is really "illegal", but it is surely highly suspect.

My patch does reject such a usage of a non-recursive procedure within itself at the moment. What do you think about the best behaviour? In my opinion, it is suspect to do so in any case and we could reject *any* usage as procedure expression of non-recursive procedures to safeguard. On the other hand, I guess this could lead to rejects-valid situations and we should think about F77 compatibility where the solution of adding "RECURSIVE" is not available. Maybe we could reject such usage only with "-pedantic"? Or we could implement "strict" checking and add a new flag to disable it, like -funsafe-recursive or -fpermissive-recursive.

I attached the current patch reflecting the basic idea and open for adaptions according to your opinions on the point above; in this version it regression-tests fine on GNU/Linux-x86-32.

Cheers,
Daniel

PS: It seems that resolve_actual_arglist never calls gfc_resolve_expr on procedure expressions in the arglist. Is this a "bug" (without impacts) or intended? On the other hand, gfc_resolve_expr *is* called for RHS's of procedure pointer assignments, for instance. I'd have guessed that gfc_resolve_expr "should" also be called for the actual arguments.



--
Done:  Arc-Bar-Cav-Rog-Sam-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran-Tou
2008-11-16  Daniel Kraft  <d@domob.eu>

	PR fortran/37779
	* resolve.c (resolve_procedure_expression): New method.
	(resolve_actual_arglist): Call it for procedure argument expressions.
	(resolve_variable): Ditto.

2008-11-16  Daniel Kraft  <d@domob.eu>

	PR fortran/37779
	* gfortran.dg/c_funloc_tests.f03: Added missing `RECURSIVE'.
	* gfortran.dg/recursive_check_4.f03: New test.
	* gfortran.dg/recursive_check_5.f03: New test.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 141880)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1072,6 +1072,38 @@ 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.  This is not included in
+   gfc_resolve_expr, as passed procedures as actual arguments seem not to be
+   resolved that way by resolve_actual_arglist.  */
+
+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 suspect, warn about it.  */
+  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 FAILURE;
+    }
+  
+  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 +1212,8 @@ resolve_actual_arglist (gfc_actual_argli
 		&& 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 +1243,9 @@ resolve_actual_arglist (gfc_actual_argli
 	      sym->attr.intrinsic = 1;
 	      sym->attr.function = 1;
 	    }
+
+	  if (resolve_procedure_expression (e) == FAILURE)
+	    return FAILURE;
 	  goto argument_list;
 	}
 
@@ -1235,6 +1270,8 @@ resolve_actual_arglist (gfc_actual_argli
 	  || sym->attr.intrinsic
 	  || sym->attr.external)
 	{
+	  if (resolve_procedure_expression (e) == FAILURE)
+	    return FAILURE;
 	  goto argument_list;
 	}
 
@@ -4157,7 +4194,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)
@@ -4239,6 +4276,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;
 }
 
Index: gcc/testsuite/gfortran.dg/c_funloc_tests.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_funloc_tests.f03	(revision 141880)
+++ gcc/testsuite/gfortran.dg/c_funloc_tests.f03	(working copy)
@@ -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)
Index: gcc/testsuite/gfortran.dg/recursive_check_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/recursive_check_5.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/recursive_check_5.f03	(revision 0)
@@ -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" } }
Index: gcc/testsuite/gfortran.dg/recursive_check_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/recursive_check_4.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/recursive_check_4.f03	(revision 0)
@@ -0,0 +1,27 @@
+! { 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 test () ! { dg-error "is not RECURSIVE" }
+    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" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]