------- Comment #6 from pault at gcc dot gnu dot org 2006-04-03 19:44 -------
The patch fixes the problem by bolting the context to the floor and putting
concrete on it. The first gfc_evaluate_now prevents the error and the second
gets us a consistent result.
Should I detect that the first argument is in the parent context and only fix
the values on that being the case?
Paul
PS Hmmm. I now cannot obtain the fault with an unpatched version, in spite of
provoking it today, repeatedly, on both FC3 and Cygwin.... Curiouser and
curiouser.
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (revision 112634)
--- gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 2700,2705 ****
--- 2700,2706 ----
gfc_se argse;
tree type;
tree ptr;
+ tree tmp;
gfc_ss *ss;
/* Get a pointer to the source. */
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 2707,2722 ****
ss = gfc_walk_expr (arg->expr);
gfc_init_se (&argse, NULL);
if (ss == gfc_ss_terminator)
! gfc_conv_expr_reference (&argse, arg->expr);
else
! gfc_conv_array_parameter (&argse, arg->expr, ss, 1);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
- ptr = argse.expr;
arg = arg->next;
type = gfc_typenode_for_spec (&expr->ts);
ptr = convert (build_pointer_type (type), ptr);
if (expr->ts.type == BT_CHARACTER)
{
gfc_init_se (&argse, NULL);
--- 2708,2732 ----
ss = gfc_walk_expr (arg->expr);
gfc_init_se (&argse, NULL);
if (ss == gfc_ss_terminator)
! {
! gfc_conv_expr_reference (&argse, arg->expr);
! tmp = build_fold_indirect_ref (argse.expr);
! tmp = gfc_evaluate_now (tmp, &argse.pre);
! ptr = build_fold_addr_expr (tmp);
! }
else
! {
! gfc_conv_array_parameter (&argse, arg->expr, ss, 1);
! ptr = argse.expr;
! }
!
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
arg = arg->next;
type = gfc_typenode_for_spec (&expr->ts);
ptr = convert (build_pointer_type (type), ptr);
+
if (expr->ts.type == BT_CHARACTER)
{
gfc_init_se (&argse, NULL);
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 2730,2735 ****
--- 2740,2747 ----
{
se->expr = build_fold_indirect_ref (ptr);
}
+
+ se->expr = gfc_evaluate_now (se->expr, &se->pre);
}
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26994
