re PR fortran/27613 (compile fails with "Unclassifiable statement" error message)

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.

From-SVN: r113951

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7e98c4677d1584201834b771d567495545e32e1b..7f80e376e6732c34fe3e19e5a6dff81a199e6845 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 56cff2c29a91b9f305c4f5c0831a902bd2ce2fa5..967bcb04364f9965628c4ffbef3b720555b98a07 100644 (file)
--- 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 737e18076e11161ebda9c5b44541340ba1dcd8a8..13713e64087d6147d7835e9e46c1e21a491a5230 100644 (file)
--- 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 (file)
index 0000000..3753e1a
--- /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