This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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 all,

once again a slightly revised version; I converted the warnings back to errors as suggested by Paul and Tobias. The second change is that I converted the calls inside resolve_actual_arglist from resolve_procedure_expression to the general gfc_resolve_expr, so as to "fix the problem" that this was never called for procedure actual argument expressions. I believe this is the cleaner solution, but I'm also fine with using the old version of the patch instead.

No regressions on GNU/Linux-x86-32 for this one, either.

After we decide on how to handle this best, I will work on the second part of PR 37779 to catch calls from contained procedures to their parent as in comment #2.

Cheers,
Daniel

Daniel Kraft wrote:
Hi all,

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-22  Daniel Kraft  <d@domob.eu>

	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-16  Daniel Kraft  <d@domob.eu>

	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.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 141880)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1072,6 +1072,36 @@ 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_error ("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 +1210,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 +1241,9 @@ resolve_actual_arglist (gfc_actual_argli
 	      sym->attr.intrinsic = 1;
 	      sym->attr.function = 1;
 	    }
+
+	  if (gfc_resolve_expr (e) == FAILURE)
+	    return FAILURE;
 	  goto argument_list;
 	}
 
@@ -1235,6 +1268,8 @@ resolve_actual_arglist (gfc_actual_argli
 	  || sym->attr.intrinsic
 	  || sym->attr.external)
 	{
+	  if (gfc_resolve_expr (e) == FAILURE)
+	    return FAILURE;
 	  goto argument_list;
 	}
 
@@ -4157,7 +4192,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 +4274,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_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03	(revision 141880)
+++ gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03	(working copy)
@@ -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
     
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,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-error "Non-RECURSIVE" }
+    procptr => test ! { dg-error "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]