re PR fortran/30876 (Array valued recursive function rejected)

2007-05-11 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/30876
	* trans-expr.c (gfc_conv_function_call): Reduce indirection for
	direct assignments of recursive array valued functions.
	* primary.c (gfc_match_rvalue): Correct error for recursive
	function calls such that directly recursive calls of scalar
	function without an explicit result are disallowed.

2007-05-11 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/30876
	* gfortran.dg/recursive_reference_1.f90: Put error at correct
	line.
	* gfortran.dg/recursive_reference_2.f90: New test.

From-SVN: r124616

6 files changed, 73 insertions, 12 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 01eb910..531e4da 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,14 @@
 2007-05-11 Paul Thomas <pault@gcc.gnu.org>
 
+	PR fortran/30876
+	* trans-expr.c (gfc_conv_function_call): Reduce indirection for
+	direct assignments of recursive array valued functions.
+	* primary.c (gfc_match_rvalue): Correct error for recursive
+	function calls such that directly recursive calls of scalar
+	function without an explicit result are disallowed.
+
+2007-05-11 Paul Thomas <pault@gcc.gnu.org>
+
 	PR fortran/30878
 	* resolve.c (resolve_fl_namelist): It is not an error if the
 	namelist element is the result variable of the enclosing
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 902279c..653df5d 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2062,17 +2062,16 @@ gfc_match_rvalue (gfc_expr **result)
       gfc_gobble_whitespace ();
       if (sym->attr.recursive
 	  && gfc_peek_char () == '('
-	  && gfc_current_ns->proc_name == sym)
+	  && gfc_current_ns->proc_name == sym
+	  && !sym->attr.dimension)
 	{
-	  if (!sym->attr.dimension)
-	    goto function0;
-
-	  gfc_error ("'%s' is array valued and directly recursive "
-		     "at %C , so the keyword RESULT must be specified "
-		     "in the FUNCTION statement", sym->name);
+	  gfc_error ("'%s' at %C is the name of a recursive function "
+		     "and so refers to the result variable. Use an "
+		     "explicit RESULT variable for direct recursion "
+		     "(12.5.2.1)", sym->name);
 	  return MATCH_ERROR;
 	}
-	
+
       if (gfc_current_ns->proc_name == sym
 	  || (gfc_current_ns->parent != NULL
 	      && gfc_current_ns->parent->proc_name == sym))
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 182ec19..239e41e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2317,7 +2317,17 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   if (byref)
     {
       if (se->direct_byref)
-	retargs = gfc_chainon_list (retargs, se->expr);
+	{
+	  /* Sometimes, too much indirection can be applied; eg. for
+	     function_result = array_valued_recursive_function.  */
+	  if (TREE_TYPE (TREE_TYPE (se->expr))
+		&& TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr)))
+		&& GFC_DESCRIPTOR_TYPE_P
+			(TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr)))))
+	    se->expr = build_fold_indirect_ref (se->expr);
+
+	  retargs = gfc_chainon_list (retargs, se->expr);
+	}
       else if (sym->result->attr.dimension)
 	{
 	  gcc_assert (se->loop && info);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0ca48c0..3f60675 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,12 @@
 2007-05-11 Paul Thomas <pault@gcc.gnu.org>
 
+	PR fortran/30876
+	* gfortran.dg/recursive_reference_1.f90: Put error at correct
+	line.
+	* gfortran.dg/recursive_reference_2.f90: New test.
+
+2007-05-11 Paul Thomas <pault@gcc.gnu.org>
+
 	PR fortran/30878
 	* gfortran.dg/namelist_29.f90: New test.
 
diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
index 3753e1a..3ca6bcb 100644
--- a/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
+++ b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
@@ -1,7 +1,9 @@
 ! { dg-do compile }
 ! Tests the patch for PR27613, in which directly recursive, scalar
 ! functions were generating an "unclassifiable statement" error
-! for the recursive statement(s).
+! for the recursive statement(s).  This was subsequently determined
+! to be wrong code and the error on 'bad_stuff' was removed.
+! See 12.5.2.1 of the standard and PR30876.
 !
 ! Based on PR testcase by Nicolas Bock  <nicolasbock@gmail.com>
 !
@@ -15,7 +17,7 @@ contains
     integer :: n
     original_stuff = 1
     if(n < 5) then
-      original_stuff = original_stuff + original_stuff (n+1)
+      original_stuff = original_stuff + original_stuff (n+1) ! { dg-error "name of a recursive function" }
     endif
   end function original_stuff
 
@@ -42,7 +44,7 @@ contains
     integer :: n(2)
     bad_stuff = 1
     if(maxval (n) < 5) then
-      bad_stuff = bad_stuff + bad_stuff (n+1) ! { dg-error "RESULT must be specified" }
+      bad_stuff = bad_stuff + bad_stuff (n+1)
     endif
   end function bad_stuff
 end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_2.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_2.f90
new file mode 100644
index 0000000..59df43c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_reference_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Tests the fix for PR30876 in which interface derived types were
+! not always being associated.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+CONTAINS
+ FUNCTION correct_input(i)
+   INTEGER :: i,correct_input(5), ans(5) = 0
+   IF (i<1) correct_input=test(1)
+   IF (i>5) correct_input=test(5)
+ END FUNCTION correct_input
+
+ RECURSIVE FUNCTION test(i)
+  INTEGER :: test(5),i,j
+  IF (i<1 .OR. i>5) THEN
+    test=correct_input(i)
+  ELSE
+    test=0
+    test(1:6-i)=(/(j,j=i,5)/)
+    test=test(3)
+  ENDIF
+ END FUNCTION
+
+END MODULE M1
+
+USE M1
+integer :: ans(5)
+IF (ANY(TEST(3).NE.(/5,5,5,5,5/))) CALL ABORT()
+IF (ANY(TEST(6).NE.(/0,0,0,0,0/))) CALL ABORT()
+END
+! { dg-final { cleanup-modules "m1" } }
+