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

re PR fortran/31215 (ICE on valid code with gfortran) 

2007-03-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31215
	* trans-expr.c (gfc_apply_interface_mapping_to_expr): Return
	int result that is non-zero if the expression is the function
	result.  Only the characteristics of the result expression
	can be used in a procedure interface, so simplify LEN in situ
	using its character length.

	PR fortran/31219
	PR fortran/31200
	* trans-expr.c (gfc_conv_function_call): Do not use
	gfc_conv_expr_reference for actual pointer function with formal
	target because a temporary is created that does not transfer
	the reference correctly.  Do not indirect formal pointer
	functions since it is the function reference that is needed.

2007-03-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31219
	* gfortran.dg/pointer_function_actual_1.f90: New test.

	PR fortran/31200
	* gfortran.dg/pointer_function_actual_2.f90: New test.

	PR fortran/31215
	* gfortran.dg/result_in_spec_1.f90: New test.

From-SVN: r123183
This commit is contained in:
Paul Thomas 2007-03-24 12:30:58 +00:00
parent d87008f258
commit 6a661315c2
6 changed files with 184 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/fortran/ChangeLog
View File

@ -1,3 +1,20 @@
2007-03-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31215
* trans-expr.c (gfc_apply_interface_mapping_to_expr): Return
int result that is non-zero if the expression is the function
result. Only the characteristics of the result expression
can be used in a procedure interface, so simplify LEN in situ
using its character length.
PR fortran/31219
PR fortran/31200
* trans-expr.c (gfc_conv_function_call): Do not use
gfc_conv_expr_reference for actual pointer function with formal
target because a temporary is created that does not transfer
the reference correctly. Do not indirect formal pointer
functions since it is the function reference that is needed.
2007-03-24 Brooks Moses <brooks.moses@codesourcery.com>
* gfortran.h: Edit comments on GFC_STD_*.

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

@ -43,7 +43,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "dependency.h"
static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr);
static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
static int gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
gfc_expr *);
/* Copy the scalarization loop variables. */
@ -1601,15 +1601,16 @@ gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping,
dummy arguments that MAPPING maps to actual arguments. Replace each such
reference with a reference to the associated actual argument. */
static void
static int
gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
gfc_expr * expr)
{
gfc_interface_sym_mapping *sym;
gfc_actual_arglist *actual;
int seen_result = 0;
if (!expr)
return;
return 0;
/* Copying an expression does not copy its length, so do that here. */
if (expr->ts.type == BT_CHARACTER && expr->ts.cl)
@ -1631,6 +1632,8 @@ gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
switch (expr->expr_type)
{
case EXPR_VARIABLE:
if (expr->symtree->n.sym->attr.result)
seen_result = 1;
case EXPR_CONSTANT:
case EXPR_NULL:
case EXPR_SUBSTRING:
@ -1642,6 +1645,21 @@ gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
break;
case EXPR_FUNCTION:
if (expr->value.function.actual->expr->expr_type == EXPR_VARIABLE
&& gfc_apply_interface_mapping_to_expr (mapping,
expr->value.function.actual->expr)
&& expr->value.function.esym == NULL
&& expr->value.function.isym != NULL
&& expr->value.function.isym->generic_id == GFC_ISYM_LEN)
{
gfc_expr *new_expr;
new_expr = gfc_copy_expr (expr->value.function.actual->expr->ts.cl->length);
*expr = *new_expr;
gfc_free (new_expr);
gfc_apply_interface_mapping_to_expr (mapping, expr);
break;
}
for (sym = mapping->syms; sym; sym = sym->next)
if (sym->old == expr->value.function.esym)
expr->value.function.esym = sym->new->n.sym;
@ -1655,6 +1673,7 @@ gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor);
break;
}
return seen_result;
}
@ -2087,11 +2106,19 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
/* Argument list functions %VAL, %LOC and %REF are signalled
through arg->name. */
conv_arglist_function (&parmse, arg->expr, arg->name);
else if ((e->expr_type == EXPR_FUNCTION)
&& e->symtree->n.sym->attr.pointer
&& fsym && fsym->attr.target)
{
gfc_conv_expr (&parmse, e);
parmse.expr = build_fold_addr_expr (parmse.expr);
}
else
{
gfc_conv_expr_reference (&parmse, e);
if (fsym && fsym->attr.pointer
&& e->expr_type != EXPR_NULL)
&& fsym->attr.flavor != FL_PROCEDURE
&& e->expr_type != EXPR_NULL)
{
/* Scalar pointer dummy args require an extra level of
indirection. The null pointer already contains

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
2007-03-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31219
* gfortran.dg/pointer_function_actual_1.f90: New test.
PR fortran/31200
* gfortran.dg/pointer_function_actual_2.f90: New test.
PR fortran/31215
* gfortran.dg/result_in_spec_1.f90: New test.
2007-03-23 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/30834

51
gcc/testsuite/gfortran.dg/pointer_function_actual_1.f90 Normal file
View File

@ -0,0 +1,51 @@
! { dg-do run }
! Tests the fix for PR31219, in which an ICE would result because
! the reference to the pointer function f would be indirected, as
! if it were the result that is being passed.
!
! COntributed by Joost VandeVondele <jv244@cam.ac.uk>
!
FUNCTION F() RESULT(RES)
INTEGER, POINTER :: RES
ALLOCATE(RES)
RES=2
END FUNCTION F
SUBROUTINE S1(f,*,*)
INTERFACE
FUNCTION F() RESULT(RES)
INTEGER, POINTER :: RES
END FUNCTION F
END INTERFACE
RETURN F()
END SUBROUTINE
PROGRAM TEST
INTERFACE
FUNCTION F() RESULT(RES)
INTEGER, POINTER :: RES
END FUNCTION F
END INTERFACE
INTERFACE
SUBROUTINE S1(f,*,*)
INTERFACE
FUNCTION F() RESULT(RES)
INTEGER, POINTER :: RES
END FUNCTION F
END INTERFACE
END SUBROUTINE
END INTERFACE
CALL S1(F,*1,*2)
1 CONTINUE
CALL ABORT()
GOTO 3
2 CONTINUE
3 CONTINUE
END

22
gcc/testsuite/gfortran.dg/pointer_function_actual_2.f90 Normal file
View File

@ -0,0 +1,22 @@
! { dg-do run }
! Tests the fix for PR31200, in which the target x would
! not be associated with p
!
! COntributed by Joost VandeVondele <jv244@cam.ac.uk>
!
REAL,TARGET :: x
CALL s3(f(x))
CONTAINS
FUNCTION f(a)
REAL,POINTER :: f
REAL,TARGET :: a
f => a
END FUNCTION
SUBROUTINE s3(targ)
REAL,TARGET :: targ
REAL,POINTER :: p
p => targ
IF (.NOT. ASSOCIATED(p,x)) CALL ABORT()
END SUBROUTINE
END

52
gcc/testsuite/gfortran.dg/result_in_spec_1.f90 Normal file
View File

@ -0,0 +1,52 @@
! { dg-do run }
! Tests the check for PR31215, in which actual/formal interface
! was not being correctly handled for the size of 'r' because
! it is a result.
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
module test1
implicit none
contains
character(f(x)) function test2(x) result(r)
implicit integer (x)
dimension r(len(r)+1)
integer, intent(in) :: x
interface
pure function f(x)
integer, intent(in) :: x
integer f
end function f
end interface
integer i
do i = 1, len(r)
r(:)(i:i) = achar(mod(i,32)+iachar('@'))
end do
end function test2
end module test1
program test
use test1
implicit none
! Original problem
if (len(test2(10)) .ne. 21) call abort ()
! Check non-intrinsic calls are OK and check that fix does
! not confuse result variables.
if (any (myfunc (test2(1)) .ne. "ABC")) call abort ()
contains
function myfunc (ch) result (chr)
character(len(ch)) :: chr(2)
character (*) :: ch(:)
if (len (ch) .ne. 3) call abort ()
if (any (ch .ne. "ABC")) call abort ()
chr = test2 (1)
if (len(test2(len(chr))) .ne. 7) call abort ()
end function myfunc
end program test
pure function f(x)
integer, intent(in) :: x
integer f
f = 2*x+1
end function f
! { dg-final { cleanup-modules "test1" } }