Fortran: Remove SAVE_EXPR on lhs in assign [PR108233]

With vectorial shaped datatypes like e.g. complex numbers, fold_convert
inserts a SAVE_EXPR.  Using that on the lhs in an assignment prevented
the update of the variable, when in a coarray.

	PR fortran/108233

gcc/fortran/ChangeLog:

	* trans-expr.cc (gfc_trans_assignment_1): Remove SAVE_EXPR on lhs.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/complex_1.f90: New test.

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8a3e737a6a8fff2e9715c65e515ae2e530b9ab9f..ab55940638e22c1f7e3fa1a42c33ae936dae403e 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -13017,11 +13017,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   else
     {
       gfc_conv_expr (&lse, expr1);
-      if (gfc_option.rtcheck & GFC_RTCHECK_MEM
-         && !init_flag
-         && gfc_expr_attr (expr1).allocatable
-         && expr1->rank
-         && !expr2->rank)
+      /* For some expression (e.g. complex numbers) fold_convert uses a
+        SAVE_EXPR, which is hazardous on the lhs, because the value is
+        not updated when assigned to.  */
+      if (TREE_CODE (lse.expr) == SAVE_EXPR)
+       lse.expr = TREE_OPERAND (lse.expr, 0);
+
+      if (gfc_option.rtcheck & GFC_RTCHECK_MEM && !init_flag
+         && gfc_expr_attr (expr1).allocatable && expr1->rank && !expr2->rank)
        {
          tree cond;
          const char* msg;

diff --git a/gcc/testsuite/gfortran.dg/coarray/complex_1.f90 b/gcc/testsuite/gfortran.dg/coarray/complex_1.f90
new file mode 100644 (file)
index 0000000..5db0b79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/complex_1.f90
@@ -0,0 +1,31 @@
+!{ dg-do run }
+
+! Check that complex numbers in coarrays can get assigned to.
+! Contributed by Harald Anlauf  <anlauf@gcc.gnu.org>
+
+program pr108233
+  implicit none
+  complex :: c = (3.0,4.0), z[*] = (6.0, 7.0)
+  complex, allocatable ::   y[:]
+  allocate (y[*])
+  y = c                 ! allocatable complex scalar coarray is OK
+  if (c /= y) error stop 1
+  z = c                 ! non-allocatable complex scalar coarray was bad
+  if (c /= z) error stop 2
+  call bcast_scalar  (z, c) ! failed too
+  if (c /= z) error stop 3
+  call assign_scalar (z, c) ! this works
+  if (c /= z) error stop 4
+contains
+  subroutine assign_scalar (out, in)
+    complex, intent(out) :: out
+    complex, intent(in)  :: in
+    out = in
+  end subroutine assign_scalar
+  subroutine bcast_scalar (out, in)
+    complex, intent(out) :: out[*]
+    complex, intent(in)  :: in
+    out = in
+  end subroutine bcast_scalar
+end
+