Commit 711d7c23 by Mikael Morin

Fix fortran scalar elemental dependency mishandling

	PR fortran/66089
gcc/fortran/
	* 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.
gcc/testsuite/
	* gfortran.dg/elemental_dependency_6.f90: New.

From-SVN: r233188
parent 861c7bcd
2016-02-05 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-03 Andre Vehreschild <vehre@gcc.gnu.org> 2016-02-03 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/67451 PR fortran/67451
......
...@@ -2464,10 +2464,12 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info) ...@@ -2464,10 +2464,12 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
return true; return true;
/* If the expression is a data reference of aggregate type, /* 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. */ 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_DERIVED
|| ss_info->expr->ts.type == BT_CLASS)) || ss_info->expr->ts.type == BT_CLASS)
&& gfc_expr_is_variable (ss_info->expr))
return true; return true;
/* Otherwise the expression is evaluated to a temporary variable before the /* 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, ...@@ -4461,6 +4463,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
gfc_ss *ss; gfc_ss *ss;
gfc_ref *lref; gfc_ref *lref;
gfc_ref *rref; gfc_ref *rref;
gfc_ss_info *ss_info;
gfc_expr *dest_expr; gfc_expr *dest_expr;
gfc_expr *ss_expr; gfc_expr *ss_expr;
int nDepend = 0; int nDepend = 0;
...@@ -4471,15 +4474,16 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, ...@@ -4471,15 +4474,16 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
for (ss = rss; ss != gfc_ss_terminator; ss = ss->next) 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; nDepend = 1;
break; break;
} }
if (ss->info->type != GFC_SS_SECTION) if (ss_info->type != GFC_SS_SECTION)
{ {
if (flag_realloc_lhs if (flag_realloc_lhs
&& dest_expr != ss_expr && dest_expr != ss_expr
...@@ -4494,6 +4498,10 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, ...@@ -4494,6 +4498,10 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
nDepend = gfc_check_dependency (dest_expr, ss_expr, false); 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; continue;
} }
......
...@@ -8834,8 +8834,8 @@ gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2) ...@@ -8834,8 +8834,8 @@ gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2)
/* Tells whether the expression is to be treated as a variable reference. */ /* Tells whether the expression is to be treated as a variable reference. */
static bool bool
expr_is_variable (gfc_expr *expr) gfc_expr_is_variable (gfc_expr *expr)
{ {
gfc_expr *arg; gfc_expr *arg;
gfc_component *comp; gfc_component *comp;
...@@ -8848,7 +8848,7 @@ expr_is_variable (gfc_expr *expr) ...@@ -8848,7 +8848,7 @@ expr_is_variable (gfc_expr *expr)
if (arg) if (arg)
{ {
gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE); 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 /* A data-pointer-returning function should be considered as a variable
...@@ -9329,7 +9329,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, ...@@ -9329,7 +9329,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
must have its components deallocated afterwards. */ must have its components deallocated afterwards. */
scalar_to_array = (expr2->ts.type == BT_DERIVED scalar_to_array = (expr2->ts.type == BT_DERIVED
&& expr2->ts.u.derived->attr.alloc_comp && expr2->ts.u.derived->attr.alloc_comp
&& !expr_is_variable (expr2) && !gfc_expr_is_variable (expr2)
&& expr1->rank && !expr2->rank); && expr1->rank && !expr2->rank);
scalar_to_array |= (expr1->ts.type == BT_DERIVED scalar_to_array |= (expr1->ts.type == BT_DERIVED
&& expr1->rank && expr1->rank
...@@ -9373,7 +9373,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, ...@@ -9373,7 +9373,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
} }
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, 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, || expr2->expr_type == EXPR_ARRAY,
!(l_is_temp || init_flag) && dealloc); !(l_is_temp || init_flag) && dealloc);
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
......
...@@ -210,6 +210,10 @@ typedef struct gfc_ss_info ...@@ -210,6 +210,10 @@ typedef struct gfc_ss_info
this is the symbol of the corresponding dummy argument. */ this is the symbol of the corresponding dummy argument. */
gfc_symbol *dummy_arg; gfc_symbol *dummy_arg;
tree value; 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; scalar;
...@@ -464,6 +468,7 @@ bool gfc_conv_ieee_arithmetic_function (gfc_se *, gfc_expr *); ...@@ -464,6 +468,7 @@ bool gfc_conv_ieee_arithmetic_function (gfc_se *, gfc_expr *);
tree gfc_save_fp_state (stmtblock_t *); tree gfc_save_fp_state (stmtblock_t *);
void gfc_restore_fp_state (stmtblock_t *, tree); 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 /* Does an intrinsic map directly to an external library call
This is true for array-returning intrinsics, unless This is true for array-returning intrinsics, unless
......
2016-02-05 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/66089
* gfortran.dg/elemental_dependency_6.f90: New.
2016-02-05 Jakub Jelinek <jakub@redhat.com> 2016-02-05 Jakub Jelinek <jakub@redhat.com>
PR rtl-optimization/69691 PR rtl-optimization/69691
......
! { 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) :: b, c
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment