From 811849c027531923175a35b52eecce0368d36a2e Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 21 May 2006 11:53:02 +0000 Subject: [PATCH] re PR fortran/27613 (compile fails with "Unclassifiable statement" error message) 2006-05-21 Paul Thomas 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 PR fortran/27613 * gfortran.dg/recursive_reference_1.f90: New test. From-SVN: r113951 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/primary.c | 15 ++++++ gcc/testsuite/ChangeLog | 6 +-- .../gfortran.dg/recursive_reference_1.f90 | 48 +++++++++++++++++++ 4 files changed, 73 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/recursive_reference_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e98c4677d1..7f80e376e67 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2006-05-21 Paul Thomas + + 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 PR fortran/25746 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 +2006-05-21 Paul Thomas - 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 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 +! +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