@@ -2464,10 +2464,12 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
return true;
/* If the expression is a data reference of aggregate type,
+ and the data reference is not used on the left hand side,
avoid a copy by saving a reference to the content. */
- if (ss_info->expr->expr_type == EXPR_VARIABLE
+ if (!ss_info->data.scalar.needs_temporary
&& (ss_info->expr->ts.type == BT_DERIVED
- || ss_info->expr->ts.type == BT_CLASS))
+ || ss_info->expr->ts.type == BT_CLASS)
+ && gfc_expr_is_variable (ss_info->expr))
return true;
/* Otherwise the expression is evaluated to a temporary variable before the
@@ -4461,6 +4463,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
gfc_ss *ss;
gfc_ref *lref;
gfc_ref *rref;
+ gfc_ss_info *ss_info;
gfc_expr *dest_expr;
gfc_expr *ss_expr;
int nDepend = 0;
@@ -4471,15 +4474,16 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
{
- ss_expr = ss->info->expr;
+ ss_info = ss->info;
+ ss_expr = ss_info->expr;
- if (ss->info->array_outer_dependency)
+ if (ss_info->array_outer_dependency)
{
nDepend = 1;
break;
}
- if (ss->info->type != GFC_SS_SECTION)
+ if (ss_info->type != GFC_SS_SECTION)
{
if (flag_realloc_lhs
&& dest_expr != ss_expr
@@ -4494,6 +4498,10 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
nDepend = gfc_check_dependency (dest_expr, ss_expr, false);
+ if (ss_info->type == GFC_SS_REFERENCE
+ && gfc_check_dependency (dest_expr, ss_expr, false))
+ ss_info->data.scalar.needs_temporary = 1;
+
continue;
}
@@ -8825,8 +8825,8 @@ gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2)
/* Tells whether the expression is to be treated as a variable reference. */
-static bool
-expr_is_variable (gfc_expr *expr)
+bool
+gfc_expr_is_variable (gfc_expr *expr)
{
gfc_expr *arg;
gfc_component *comp;
@@ -8839,7 +8839,7 @@ expr_is_variable (gfc_expr *expr)
if (arg)
{
gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
- return expr_is_variable (arg);
+ return gfc_expr_is_variable (arg);
}
/* A data-pointer-returning function should be considered as a variable
@@ -9320,7 +9320,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
must have its components deallocated afterwards. */
scalar_to_array = (expr2->ts.type == BT_DERIVED
&& expr2->ts.u.derived->attr.alloc_comp
- && !expr_is_variable (expr2)
+ && !gfc_expr_is_variable (expr2)
&& expr1->rank && !expr2->rank);
scalar_to_array |= (expr1->ts.type == BT_DERIVED
&& expr1->rank
@@ -9364,7 +9364,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
}
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
- expr_is_variable (expr2) || scalar_to_array
+ gfc_expr_is_variable (expr2) || scalar_to_array
|| expr2->expr_type == EXPR_ARRAY,
!(l_is_temp || init_flag) && dealloc);
gfc_add_expr_to_block (&body, tmp);
@@ -210,6 +210,10 @@ typedef struct gfc_ss_info
this is the symbol of the corresponding dummy argument. */
gfc_symbol *dummy_arg;
tree value;
+ /* Tells that the scalar is a reference to a variable that might
+ be present on the lhs, so that we should evaluate the value
+ itself before the loop, not just the reference. */
+ unsigned needs_temporary:1;
}
scalar;
@@ -464,6 +468,7 @@ bool gfc_conv_ieee_arithmetic_function (gfc_se *, gfc_expr *);
tree gfc_save_fp_state (stmtblock_t *);
void gfc_restore_fp_state (stmtblock_t *, tree);
+bool gfc_expr_is_variable (gfc_expr *);
/* Does an intrinsic map directly to an external library call
This is true for array-returning intrinsics, unless
new file mode 100644
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR fortran/66089
+! Check that we do create a temporary for C(1) below in the assignment
+! to C.
+
+ type :: t
+ integer :: c
+ end type t
+
+ type(t), dimension(5) :: a, b, c
+
+ a = t(1)
+ b = t(7)
+ c = t(13)
+ c = plus(c(1), b)
+! print *, c
+ if (any(c%c /= 20)) call abort
+
+contains
+
+ elemental function plus(lhs, rhs)
+ type(t), intent(in) :: lhs, rhs
+ type(t) :: plus
+ plus%c = lhs%c + rhs%c
+ end function plus
+
+end
Hello, this is about the case c(:) = elemental_func(c(1), ...) where as a result of a trunk change, only a reference to c(1) is saved to a temporary variable, instead of its value. The fix tries to save the amount of copying as much as possible by detecting the above case. Technically through the usage of a new field needs_temporary. The patch is a variant of the one that has been on bugzilla for months. The main difference is the usage of gfc_expr_is_variable instead of the check for expr_type == EXPR_VARIABLE (the former includes pointer-returning functions as well). Regression-tested on x86_64-unknown-linux-gnu. OK for trunk? Mikael 2016-02-01 Mikael Morin <mikael@gcc.gnu.org> PR fortran/66089 * trans-expr.c (expr_is_variable, gfc_expr_is_variable): Rename the former to the latter and make it non-static. Update callers. * gfortran.h (gfc_expr_is_variable): New declaration. (struct gfc_ss_info): Add field needs_temporary. * trans-array.c (gfc_scalar_elemental_arg_saved_as_argument): Tighten the condition on aggregate expressions with a check that the expression is a variable and doesn't need a temporary. (gfc_conv_resolve_dependency): Add intermediary reference variable. Set the needs_temporary field. 2016-02-01 Mikael Morin <mikael@gcc.gnu.org> PR fortran/66089 * gfortran.dg/elemental_dependency_6.f90: New.