diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 01eb9108e95..531e4da969f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-05-11 Paul Thomas + + 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 PR fortran/30878 diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 902279c24a0..653df5d4162 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 182ec19e12b..239e41e1f8b 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 0ca48c0db4e..3f606756982 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2007-05-11 Paul Thomas + + 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 PR fortran/30878 diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 index 3753e1a0acd..3ca6bcb1711 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 ! @@ -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 00000000000..59df43cdf1a --- /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 +! +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" } } +