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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 01eb9108e9565f7bde93efb2ffd473b90620fe6a..531e4da969fa6624c4719390f061847520006cca 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 902279c24a078b754dfb69da91cdae3d1feb06f6..653df5d4162360d3e10583e830f120a002916d69 100644 (file)
--- 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 182ec19e12b61cfa4defceeb0f6bf607a54123f5..239e41e1f8b88ab7690f3163ebaf394fa4ae29c6 100644 (file)
--- 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 0ca48c0db4e25772a7b10924a065568502f037ad..3f606756982652cb93264ba6ab7a7b18fdfb881f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
index 3753e1a0acd042c1f269278b0a5f4e02c1501323..3ca6bcb17117e700a06c449f08c06e9fb6ddfc4e 100644 (file)
--- 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 (file)
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" } }
+