Fix PR 94578.
authorThomas König <tkoenig@gcc.gnu.org>
Sat, 25 Apr 2020 10:28:15 +0000 (12:28 +0200)
committerThomas König <tkoenig@gcc.gnu.org>
Sat, 25 Apr 2020 10:28:15 +0000 (12:28 +0200)
Our intrinsics do not handle spans on their return values (yet),
so this creates a temporary for subref array pointers.

2020-04-25  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/94578
* trans-expr.c (arrayfunc_assign_needs_temporary): If the
LHS is a subref pointer, we also need a temporary.

2020-04-25  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/94578
* gfortran.dg/pointer_assign_14.f90: New test.
* gfortran.dg/pointer_assign_15.f90: New test.

gcc/fortran/trans-expr.c
gcc/testsuite/gfortran.dg/pointer_assign_14.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pointer_assign_15.f90 [new file with mode: 0644]

index fdca9cc..030edc1 100644 (file)
@@ -9823,9 +9823,13 @@ arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2)
 
   /* If we have reached here with an intrinsic function, we do not
      need a temporary except in the particular case that reallocation
-     on assignment is active and the lhs is allocatable and a target.  */
+     on assignment is active and the lhs is allocatable and a target,
+     or a pointer which may be a subref pointer.  FIXME: The last
+     condition can go away when we use span in the intrinsics
+     directly.*/
   if (expr2->value.function.isym)
-    return (flag_realloc_lhs && sym->attr.allocatable && sym->attr.target);
+    return (flag_realloc_lhs && sym->attr.allocatable && sym->attr.target)
+      || (sym->attr.pointer && sym->attr.subref_array_pointer);
 
   /* If the LHS is a dummy, we need a temporary if it is not
      INTENT(OUT).  */
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_14.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_14.f90
new file mode 100644 (file)
index 0000000..b06dd84
--- /dev/null
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR fortran/94578
+! This used to give wrong results.
+program main
+  implicit none
+  type foo
+     integer :: x, y,z
+  end type foo
+  integer :: i
+  integer, dimension(:), pointer :: array1d
+  type(foo), dimension(2), target :: solution
+  integer, dimension(2,2) :: a
+  data a /1,2,3,4/
+  solution%x = -10
+  solution%y = -20
+  array1d => solution%x
+  array1d = maxval(a,dim=1)
+  if (any (array1d /= [2,4])) stop 1
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_15.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_15.f90
new file mode 100644 (file)
index 0000000..7c28859
--- /dev/null
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR fortran/94578
+! This used to give wrong results.  Original test case by Jan-Willem
+! Blokland.
+program main
+  implicit none
+  type foo
+     integer :: x, y
+  end type foo
+  integer :: i
+  integer, dimension (2,2) :: array2d
+  integer, dimension(:), pointer :: array1d
+  type(foo), dimension(2*2), target :: solution
+  data array2d /1,2,3,4/
+  array1d => solution%x
+  array1d = reshape (source=array2d, shape=shape(array1d))
+  if (any (array1d /= [1,2,3,4])) stop 1
+end program main