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

re PR fortran/36703 (ICE (segfault) in reduce_binary0 (arith.c:1778))

Browse Source 
2009-02-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/36703
	PR fortran/36528
	* trans-expr.c (gfc_conv_function_val): Stabilize Cray-pointer
	function references to ensure that a valid expression is used.
	(gfc_conv_function_call): Pass Cray pointers to procedures.

2009-02-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/36528
	* gfortran.dg/cray_pointers_8.f90: New test.

	PR fortran/36703
	* gfortran.dg/cray_pointers_9.f90: New test.

From-SVN: r145196
This commit is contained in:
Paul Thomas 2009-03-28 17:08:25 +00:00
parent 6b02d5f753
commit 5d63a35f9f
4 changed files with 145 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2009-03-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38538
* trans-array.c (get_elemental_fcn_charlen): Remove.
(get_array_charlen): New function to replace previous.
2009-03-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38765

114
gcc/fortran/trans-array.c
View File

@ -4703,47 +4703,102 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
}
/* gfc_conv_expr_descriptor needs the character length of elemental
functions before the function is called so that the size of the
temporary can be obtained. The only way to do this is to convert
the expression, mapping onto the actual arguments. */
/* gfc_conv_expr_descriptor needs the string length an expression
so that the size of the temporary can be obtained. This is done
by adding up the string lengths of all the elements in the
expression. Function with non-constant expressions have their
string lengths mapped onto the actual arguments using the
interface mapping machinery in trans-expr.c. */
static void
get_elemental_fcn_charlen (gfc_expr *expr, gfc_se *se)
get_array_charlen (gfc_expr *expr, gfc_se *se)
{
gfc_interface_mapping mapping;
gfc_formal_arglist *formal;
gfc_actual_arglist *arg;
gfc_se tse;
formal = expr->symtree->n.sym->formal;
arg = expr->value.function.actual;
gfc_init_interface_mapping (&mapping);
/* Set se = NULL in the calls to the interface mapping, to suppress any
backend stuff. */
for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
if (expr->ts.cl->length
&& gfc_is_constant_expr (expr->ts.cl->length))
{
if (!arg->expr)
continue;
if (formal->sym)
gfc_add_interface_mapping (&mapping, formal->sym, NULL, arg->expr);
if (!expr->ts.cl->backend_decl)
gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
return;
}
gfc_init_se (&tse, NULL);
switch (expr->expr_type)
{
case EXPR_OP:
get_array_charlen (expr->value.op.op1, se);
/* Build the expression for the character length and convert it. */
gfc_apply_interface_mapping (&mapping, &tse, expr->ts.cl->length);
/* For parentheses the expression ts.cl is identical. */
if (expr->value.op.op == INTRINSIC_PARENTHESES)
return;
gfc_add_block_to_block (&se->pre, &tse.pre);
gfc_add_block_to_block (&se->post, &tse.post);
tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
tse.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tse.expr,
build_int_cst (gfc_charlen_type_node, 0));
expr->ts.cl->backend_decl = tse.expr;
gfc_free_interface_mapping (&mapping);
expr->ts.cl->backend_decl =
gfc_create_var (gfc_charlen_type_node, "sln");
if (expr->value.op.op2)
{
get_array_charlen (expr->value.op.op2, se);
/* Add the string lengths and assign them to the expression
string length backend declaration. */
gfc_add_modify (&se->pre, expr->ts.cl->backend_decl,
fold_build2 (PLUS_EXPR, gfc_charlen_type_node,
expr->value.op.op1->ts.cl->backend_decl,
expr->value.op.op2->ts.cl->backend_decl));
}
else
gfc_add_modify (&se->pre, expr->ts.cl->backend_decl,
expr->value.op.op1->ts.cl->backend_decl);
break;
case EXPR_FUNCTION:
if (expr->value.function.esym == NULL
|| expr->ts.cl->length->expr_type == EXPR_CONSTANT)
{
gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
break;
}
/* Map expressions involving the dummy arguments onto the actual
argument expressions. */
gfc_init_interface_mapping (&mapping);
formal = expr->symtree->n.sym->formal;
arg = expr->value.function.actual;
/* Set se = NULL in the calls to the interface mapping, to suppress any
backend stuff. */
for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
{
if (!arg->expr)
continue;
if (formal->sym)
gfc_add_interface_mapping (&mapping, formal->sym, NULL, arg->expr);
}
gfc_init_se (&tse, NULL);
/* Build the expression for the character length and convert it. */
gfc_apply_interface_mapping (&mapping, &tse, expr->ts.cl->length);
gfc_add_block_to_block (&se->pre, &tse.pre);
gfc_add_block_to_block (&se->post, &tse.post);
tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
tse.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tse.expr,
build_int_cst (gfc_charlen_type_node, 0));
expr->ts.cl->backend_decl = tse.expr;
gfc_free_interface_mapping (&mapping);
break;
default:
gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
break;
}
}
/* Convert an array for passing as an actual argument. Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed. For whole arrays the descriptor is passed. For array sections
@ -4879,7 +4934,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
need_tmp = 1;
if (expr->ts.type == BT_CHARACTER
&& expr->ts.cl->length->expr_type != EXPR_CONSTANT)
get_elemental_fcn_charlen (expr, se);
get_array_charlen (expr, se);
info = NULL;
}
@ -4939,8 +4994,9 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
loop.temp_ss->type = GFC_SS_TEMP;
loop.temp_ss->next = gfc_ss_terminator;
if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
if (expr->ts.type == BT_CHARACTER
&& !expr->ts.cl->backend_decl)
get_array_charlen (expr, se);
loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-03-28 Paul Thomas <pault@gcc.gnu.org
PR fortran/38538
* gfortran.dg/char_result_13.f90: New test.
2009-03-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38765

49
gcc/testsuite/gfortran.dg/char_result_13.f90 Normal file
View File

@ -0,0 +1,49 @@
! { dg-do run }
! Tests the fix for PR38538, where the character length for the
! argument of 'func' was not calculated.
!
! Contributed by Vivek Rao <vivekrao4@yahoo.com>
!
module abc
implicit none
contains
subroutine xmain (i, j)
integer i, j
call foo (func ("_"//bar (i)//"x"//bar (j)//"x"), "_abcxabx") ! original was elemental
call foo (nfunc("_"//bar (j)//"x"//bar (i)//"x"), "_abxabcx")
end subroutine xmain
!
function bar (i) result(yy)
integer i, j, k
character (len = i) :: yy(2)
do j = 1, size (yy, 1)
do k = 1, i
yy(j)(k:k) = char (96+k)
end do
end do
end function bar
!
elemental function func (yy) result(xy)
character (len = *), intent(in) :: yy
character (len = len (yy)) :: xy
xy = yy
end function func
!
function nfunc (yy) result(xy)
character (len = *), intent(in) :: yy(:)
character (len = len (yy)) :: xy(size (yy))
xy = yy
end function nfunc
!
subroutine foo(cc, teststr)
character (len=*), intent(in) :: cc(:)
character (len=*), intent(in) :: teststr
if (any (cc .ne. teststr)) call abort
end subroutine foo
end module abc
use abc
call xmain(3, 2)
end
! { dg-final { cleanup-modules "abc" } }