Fix fortran scalar elemental dependency mishandling
authorMikael Morin <mikael@gcc.gnu.org>
Fri, 5 Feb 2016 21:41:15 +0000 (21:41 +0000)
committerMikael Morin <mikael@gcc.gnu.org>
Fri, 5 Feb 2016 21:41:15 +0000 (21:41 +0000)
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

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-expr.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/elemental_dependency_6.f90 [new file with mode: 0644]

index dc0b8f2..f94fbe5 100644 (file)
@@ -1,3 +1,16 @@
+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>
 
        PR fortran/67451
index eeb688c..2ff2833 100644 (file)
@@ -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;
        }
 
index 87af7ac..4baadc8 100644 (file)
@@ -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.  */
 
-static bool
-expr_is_variable (gfc_expr *expr)
+bool
+gfc_expr_is_variable (gfc_expr *expr)
 {
   gfc_expr *arg;
   gfc_component *comp;
@@ -8848,7 +8848,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
@@ -9329,7 +9329,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
@@ -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,
-                                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);
index 3026e3b..316ee9b 100644 (file)
@@ -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
index abd3156..61306d0 100644 (file)
@@ -1,3 +1,8 @@
+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>
 
        PR rtl-optimization/69691
diff --git a/gcc/testsuite/gfortran.dg/elemental_dependency_6.f90 b/gcc/testsuite/gfortran.dg/elemental_dependency_6.f90
new file mode 100644 (file)
index 0000000..fd1aa40
--- /dev/null
@@ -0,0 +1,27 @@
+! { 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