2006-05-21 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/27613
	* primary.c (gfc_match_rvalue): Test if symbol represents a
	direct recursive function reference.  Error if array valued,
	go to function0 otherwise.

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/27613
	* gfortran.dg/recursive_reference_1.f90: New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@113951 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 73 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7e98c4677d1..7f80e376e67 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,12 @@
 2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
 
+	PR fortran/27613
+	* primary.c (gfc_match_rvalue): Test if symbol represents a
+	direct recursive function reference.  Error if array valued,
+	go to function0 otherwise.
+
+2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/25746
 	* interface.c (gfc_extend_assign): Use new EXEC_ASSIGN_CALL.
 	* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 56cff2c29a9..967bcb04364 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1933,6 +1933,21 @@ gfc_match_rvalue (gfc_expr ** result)
 
   if (sym->attr.function && sym->result == sym)
     {
+      /* See if this is a directly recursive function call.  */
+      gfc_gobble_whitespace ();
+      if (sym->attr.recursive
+	    && gfc_peek_char () == '('
+	    && gfc_current_ns->proc_name == sym)
+	{
+	  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);
+	  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/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 737e18076e1..13713e64087 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,7 @@
-2006-05-21  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
 
-	PR c++/27398
-	* g++.dg/template/crash50.C: New test.
+	PR fortran/27613
+	* gfortran.dg/recursive_reference_1.f90: New test.
 
 2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
 
diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
new file mode 100644
index 00000000000..3753e1a0acd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
@@ -0,0 +1,48 @@
+! { 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).
+!
+! Based on PR testcase by Nicolas Bock  <nicolasbock@gmail.com>
+!
+program test
+  if (original_stuff(1) .ne. 5) call abort ()
+  if (scalar_stuff(-4) .ne. 10) call abort ()
+  if (any (array_stuff((/-19,-30/)) .ne. (/25,25/))) call abort ()
+contains
+  recursive function original_stuff(n)
+    integer :: original_stuff
+    integer :: n
+    original_stuff = 1
+    if(n < 5) then
+      original_stuff = original_stuff + original_stuff (n+1)
+    endif
+  end function original_stuff
+
+  recursive function scalar_stuff(n) result (tmp)
+    integer :: tmp
+    integer :: n
+    tmp = 1
+    if(n < 5) then
+      tmp = tmp + scalar_stuff (n+1)
+    endif
+  end function scalar_stuff
+
+  recursive function array_stuff(n) result (tmp)
+    integer :: tmp (2)
+    integer :: n (2)
+    tmp = 1
+    if(maxval (n) < 5) then
+      tmp = tmp + array_stuff (n+1)
+    endif
+  end function array_stuff
+
+  recursive function bad_stuff(n)
+    integer :: bad_stuff (2)
+    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" }
+    endif
+  end function bad_stuff
+end program test