------- Comment #2 from paul dot richard dot thomas at cea dot fr 2006-04-12
14:34 -------
I have a fix for it, which is regtesting right now. Even if it fails in this
form, it is along the right lines and there will be a version that is pukkah. I
hope to submit the patch tonight.
Quite simply, the fix consists of gathering up all the argument post_blocks,
which contain the unpacking and freeing of argument temporaries, and putting
them into a separate block. Once the function call is translated, it either
goes in the se->pre block or becomes the se expression, depending on how the
value is returned. Depending on this same choice, we now add the argument post
block to se->pre or to se->post. This ensures that the results of byref calls
that produce temporaries are transferred to the destination array AFTER the
unpacking of the argument. The reduced testcase below now runs correctly.
The patch and testcase appear below.
Paul
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (révision 112853)
+++ gcc/fortran/trans-expr.c (copie de travail)
@@ -1832,6 +1832,7 @@
gfc_charlen cl;
gfc_expr *e;
gfc_symbol *fsym;
+ stmtblock_t post;
arglist = NULL_TREE;
retargs = NULL_TREE;
@@ -1861,6 +1862,7 @@
else
info = NULL;
+ gfc_init_block (&post);
gfc_init_interface_mapping (&mapping);
need_interface_mapping = ((sym->ts.type == BT_CHARACTER
&& sym->ts.cl->length
@@ -1970,7 +1972,7 @@
gfc_add_interface_mapping (&mapping, fsym, &parmse);
gfc_add_block_to_block (&se->pre, &parmse.pre);
- gfc_add_block_to_block (&se->post, &parmse.post);
+ gfc_add_block_to_block (&post, &parmse.post);
/* Character strings are passed as two parameters, a length and a
pointer. */
@@ -2177,6 +2179,11 @@
}
}
+ if (byref)
+ gfc_add_block_to_block (&se->pre, &post);
+ else
+ gfc_add_block_to_block (&se->post, &post);
+
return has_alternate_specifier;
}
! { dg-do run }
! Tests the fix for PR27124 in which the unpacking of argument
! temporaries and of array result temporaries occurred in the
! incorrect order.
!
! Test is based on the original example, provided by
! Philippe Schaffnit <[EMAIL PROTECTED]>
!
PROGRAM Test
INTEGER :: Array(2, 3) = reshape ((/1,4,2,5,3,6/),(/2,3/))
integer :: Brray(2, 3) = 0
Brray(1,:) = Function_Test (Array(1,:))
if (any(reshape (Brray, (/6/)) .ne. (/11, 0, 12, 0, 13, 0/))) call abort ()
Array(1,:) = Function_Test (Array(1,:))
if (any(reshape (Array, (/6/)) .ne. (/11, 4, 12, 5, 13, 6/))) call abort ()
contains
FUNCTION Function_Test (Input)
INTEGER, INTENT(IN) :: Input(1:3)
INTEGER :: Function_Test(1:3)
Function_Test = Input + 10
END FUNCTION Function_Test
END PROGRAM Test
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=27124
