This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patc, fortran] PR22146 - ICE on elemental subroutine calls with array-valued actual arguments.
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: patch <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Tue, 03 Jan 2006 15:55:29 +0100
- Subject: [Patc, fortran] PR22146 - ICE on elemental subroutine calls with array-valued actual arguments.
:ADDPATCH fortran:
This patch fixes pr22146, in which elemental subroutines with array
arguments would ICE in gfc_conv_function_call. The reason is that
trans-stmt.c (gfc_trans_call) did not even attempt to scalarize the
function call. The patch provides the required scalarization.
Note that gfc_walk_elemental_function_args had to be modified by
replacing the gfc_expr, for the function call, with the
gfc_actual_arglist because the former does not apply to a subroutine call.
Also, since the ss chain produced by gfc_walk_elemental_function_args is
in the reverse order to the actual arglist, gfc_reverse_ss had its
static attribute removed and a prototype was put in trans-array.h. I am
open to the suggestion that the scalarization be moved from trans-stmt.c
to trans-array.c but, myself, could only see it as being six of one and
half-a-dozen of the other, as far as code structure and prototypes are
concerned.
The standard does indeed explicitly forbid alternate return arguments
for elemental procedures. This is caught in resolve_formal_arglist and
the right error produced but the compiler continues on to trans-xxx.c,
where it ICEs. Since the error is trapped, I consider the ICE to be of
secondary importance in what is, after all, a rather unusual error
condition. As soon as this patch is committed, I will raise a PR on
this and will add it to my TODO list.
Another TODO concerns the requirements of the standard in respect of
actual arguments: For an elemental subroutine all actual arguments must
be scalar or those associated with INTENT(OUT) and INTENT(INOUT) dummy
arguments shall be conforming arrays. For the present, I propose that
the extension of the functionality should be committed and the standard
conditional error can come later. I will raise a PR on this too, unless
Joost has already beaten me to it!
The line "call foobar (cos (x) + u, y)" in the test case produces:
{
int4 S.12;
S.12 = 1;
while (1)
{
if (S.12 > 2) goto L.10; else (void) 0;
{
real4 D.861;
D.861 = __builtin_cosf (x[NON_LVALUE_EXPR <S.12> + -1]) + D.859;
foobar (&D.861, &y[NON_LVALUE_EXPR <S.12> + -1]);
}
S.12 = S.12 + 1;
}
L.10:;
}
which seems to be entirely as it ought to be.
The testcase contains the original example, furnished by Erik Edelmann,
and adds a functional test of different mixes of scalar, array end
expression actual arguments. Once the application of the standard, in
respect of actual arguments, is applied, dg-warnings will have to be
added to the mixed scalar/array cases.
Bootstrapped and regtested on FC3/Athlon and Cygwin/Pentium
OK for trunk and 4.1?
Paul
2006-01-03 Paul Thomas <pault@gcc.gnu.org>
PR fortran/22146
* trans-array.c (gfc_reverse_ss): Remove static attribute.
(gfc_walk_elemental_function_args): Replace gfc_expr * argument for
the function call with the corresponding gfc_actual_arglist*. Change
code accordingly.
(gfc_walk_function_expr): Call to gfc_walk_elemental_function_args
now requires the actual argument list instead of the expression for
the function call.
* trans-array.h: Modify the prototype for gfc_walk_elemental_function_args
and provide a prototype for gfc_reverse_ss.
* trans-stmt.h (gfc_trans_call): Add the scalarization code for the case
where an elemental subroutine has array valued actual arguments.
2006-01-03 Paul Thomas <pault@gcc.gnu.org>
PR fortran/22146
* gfortran.dg/elemental_subroutine_1.f90: New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 109168)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_walk_op_expr (gfc_ss * ss, gfc_expr
*** 4529,4535 ****
/* Reverse a SS chain. */
! static gfc_ss *
gfc_reverse_ss (gfc_ss * ss)
{
gfc_ss *next;
--- 4529,4535 ----
/* Reverse a SS chain. */
! gfc_ss *
gfc_reverse_ss (gfc_ss * ss)
{
gfc_ss *next;
*************** gfc_reverse_ss (gfc_ss * ss)
*** 4555,4564 ****
/* Walk the arguments of an elemental function. */
gfc_ss *
! gfc_walk_elemental_function_args (gfc_ss * ss, gfc_expr * expr,
gfc_ss_type type)
{
- gfc_actual_arglist *arg;
int scalar;
gfc_ss *head;
gfc_ss *tail;
--- 4555,4563 ----
/* Walk the arguments of an elemental function. */
gfc_ss *
! gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
gfc_ss_type type)
{
int scalar;
gfc_ss *head;
gfc_ss *tail;
*************** gfc_walk_elemental_function_args (gfc_ss
*** 4567,4573 ****
head = gfc_ss_terminator;
tail = NULL;
scalar = 1;
! for (arg = expr->value.function.actual; arg; arg = arg->next)
{
if (!arg->expr)
continue;
--- 4566,4572 ----
head = gfc_ss_terminator;
tail = NULL;
scalar = 1;
! for (; arg; arg = arg->next)
{
if (!arg->expr)
continue;
*************** gfc_walk_function_expr (gfc_ss * ss, gfc
*** 4644,4650 ****
/* Walk the parameters of an elemental function. For now we always pass
by reference. */
if (sym->attr.elemental)
! return gfc_walk_elemental_function_args (ss, expr, GFC_SS_REFERENCE);
/* Scalar functions are OK as these are evaluated outside the scalarization
loop. Pass back and let the caller deal with it. */
--- 4643,4650 ----
/* Walk the parameters of an elemental function. For now we always pass
by reference. */
if (sym->attr.elemental)
! return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
! GFC_SS_REFERENCE);
/* Scalar functions are OK as these are evaluated outside the scalarization
loop. Pass back and let the caller deal with it. */
Index: gcc/fortran/trans-array.h
===================================================================
*** gcc/fortran/trans-array.h (revision 109168)
--- gcc/fortran/trans-array.h (working copy)
*************** void gfc_trans_static_array_pointer (gfc
*** 49,58 ****
/* Generate scalarization information for an expression. */
gfc_ss *gfc_walk_expr (gfc_expr *);
/* Walk the arguments of an intrinsic function. */
! gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_expr *, gfc_ss_type);
/* Walk an intrinsic function. */
gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
gfc_intrinsic_sym *);
/* Free the SS associated with a loop. */
void gfc_cleanup_loop (gfc_loopinfo *);
--- 49,60 ----
/* Generate scalarization information for an expression. */
gfc_ss *gfc_walk_expr (gfc_expr *);
/* Walk the arguments of an intrinsic function. */
! gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *, gfc_ss_type);
/* Walk an intrinsic function. */
gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
gfc_intrinsic_sym *);
+ /* Reverse the order of an SS chain. */
+ gfc_ss *gfc_reverse_ss (gfc_ss *);
/* Free the SS associated with a loop. */
void gfc_cleanup_loop (gfc_loopinfo *);
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 109168)
--- gcc/fortran/trans-stmt.c (working copy)
*************** tree
*** 209,214 ****
--- 209,215 ----
gfc_trans_call (gfc_code * code)
{
gfc_se se;
+ gfc_ss * ss;
int has_alternate_specifier;
/* A CALL starts a new block because the actual arguments may have to
*************** gfc_trans_call (gfc_code * code)
*** 218,245 ****
gcc_assert (code->resolved_sym);
! /* Translate the call. */
! has_alternate_specifier
! = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual);
!
! /* A subroutine without side-effect, by definition, does nothing! */
! TREE_SIDE_EFFECTS (se.expr) = 1;
!
! /* Chain the pieces together and return the block. */
! if (has_alternate_specifier)
! {
! gfc_code *select_code;
! gfc_symbol *sym;
! select_code = code->next;
! gcc_assert(select_code->op == EXEC_SELECT);
! sym = select_code->expr->symtree->n.sym;
! se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr);
! gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr);
}
else
! gfc_add_expr_to_block (&se.pre, se.expr);
- gfc_add_block_to_block (&se.pre, &se.post);
return gfc_finish_block (&se.pre);
}
--- 219,302 ----
gcc_assert (code->resolved_sym);
! ss = gfc_ss_terminator;
! if (code->resolved_sym->attr.elemental)
! ss = gfc_walk_elemental_function_args (ss, code->ext.actual, GFC_SS_REFERENCE);
!
! /* Is not an elemental subroutine call with array valued arguments. */
! if (ss == gfc_ss_terminator)
! {
!
! /* Translate the call. */
! has_alternate_specifier
! = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual);
!
! /* A subroutine without side-effect, by definition, does nothing! */
! TREE_SIDE_EFFECTS (se.expr) = 1;
!
! /* Chain the pieces together and return the block. */
! if (has_alternate_specifier)
! {
! gfc_code *select_code;
! gfc_symbol *sym;
! select_code = code->next;
! gcc_assert(select_code->op == EXEC_SELECT);
! sym = select_code->expr->symtree->n.sym;
! se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr);
! gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr);
! }
! else
! gfc_add_expr_to_block (&se.pre, se.expr);
!
! gfc_add_block_to_block (&se.pre, &se.post);
}
+
+ /* An elemental subroutine call with array valued arguments has
+ to be scalarized. */
else
! {
! gfc_loopinfo loop;
! stmtblock_t body;
! stmtblock_t block;
! gfc_se loopse;
!
! /* gfc_walk_elemental_function_args renders the ss chain in the
! reverse order to the actual argument order. */
! ss = gfc_reverse_ss (ss);
!
! /* Initialize the loop. */
! gfc_init_se (&loopse, NULL);
! gfc_init_loopinfo (&loop);
! gfc_add_ss_to_loop (&loop, ss);
!
! gfc_conv_ss_startstride (&loop);
! gfc_conv_loop_setup (&loop);
! gfc_mark_ss_chain_used (ss, 1);
!
! /* Generate the loop body. */
! gfc_start_scalarized_body (&loop, &body);
! gfc_init_block (&block);
! gfc_copy_loopinfo_to_se (&loopse, &loop);
! loopse.ss = ss;
!
! /* Add the subroutine call to the block. Alternate return arguments
! have already been eliminated (12.7.1). */
! gfc_conv_function_call (&loopse, code->resolved_sym, code->ext.actual);
!
! TREE_SIDE_EFFECTS (loopse.expr) = 1;
! gfc_add_expr_to_block (&loopse.pre, loopse.expr);
!
! gfc_add_block_to_block (&block, &loopse.pre);
! gfc_add_block_to_block (&block, &loopse.post);
!
! /* Finish up the loop block and the loop. */
! gfc_add_expr_to_block (&body, gfc_finish_block (&block));
! gfc_trans_scalarizing_loops (&loop, &body);
! gfc_add_block_to_block (&se.pre, &loop.pre);
! gfc_add_block_to_block (&se.pre, &loop.post);
! gfc_cleanup_loop (&loop);
! }
return gfc_finish_block (&se.pre);
}
! { dg-do run }
! Test the fix for pr22146, where and elemental subroutine with
! array actual arguments would cause an ICE in gfc_conv_function_call.
! The module is the original test case and the rest is a basic
! functional test of the scalarization of the function call.
!
! Contributed by Erik Edelmann <erik.edelmann@iki.fi>
! and Paul Thomas <pault@gcc.gnu.org>
module pr22146
contains
elemental subroutine foo(a)
integer, intent(out) :: a
a = 0
end subroutine foo
subroutine bar()
integer :: a(10)
call foo(a)
end subroutine bar
end module pr22146
use pr22146
real, dimension (2) :: x, y
real :: u, v
x = (/1.0, 2.0/)
u = 42.0
call bar ()
! Check the various combinations of scalar and array.
call foobar (x, y)
if (any(y.ne.-x)) call abort ()
call foobar (u, y)
if (any(y.ne.-42.0)) call abort ()
call foobar (u, v)
if (v.ne.-42.0) call abort ()
call foobar (x, v)
if (v.ne.-2.0) call abort ()
! Test an expression in the INTENT(IN) argument
call foobar (cos (x) + u, y)
if (any(abs (y + cos (x) + u) .gt. 2.0e-6)) call abort ()
contains
elemental subroutine foobar (a, b)
real, intent(IN) :: a
real, intent(out) :: b
b = -a
end subroutine foobar
end