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 all,

yet another revised patch... This simply removes the "return FAILURE;" spotted by Thomas and updates the recursive_check_4.f03 test so it would have failed for this error. I believe it is "better" now.

No regressions with this version, either.

Cheers,
Daniel

--
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/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,35 @@ 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 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 +1209,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 +1240,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 +1267,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 +4191,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 +4273,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-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]