OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/30876 (Array valued recursive function rejected)

Browse Source 
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
This commit is contained in:
Paul Thomas 2007-05-11 11:46:47 +00:00
parent 847b053dd2
commit fc2d8680dd
6 changed files with 73 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -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

15
gcc/fortran/primary.c
View File

@ -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))

12
gcc/fortran/trans-expr.c
View File

@ -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);

7
gcc/testsuite/ChangeLog
View File

@ -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

8
gcc/testsuite/gfortran.dg/recursive_reference_1.f90
View File

@ -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

34
gcc/testsuite/gfortran.dg/recursive_reference_2.f90 Normal file
View File

@ -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" } }