Hello world,
rather than touch 50% of the files in our libfortran
subdirectory, I opted for the simple and obvious
way - if the RHS is a pointer which may have a span,
just create a temporary. (We're also qutie close to
a release candidate if I count the P1 regressions
correctly, so this is not a time for big changes).
I think we can (and should) revisit this for gcc 11.
Committed after regression-testing. I will backport
to gcc 9 and gcc 8 soon.
Regards
Thomas
Fix PR 94578.
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 <tkoe...@gcc.gnu.org>
2020-04-25 Thomas Koenig <tkoe...@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 <tkoe...@gcc.gnu.org>
PR fortran/94578
* gfortran.dg/pointer_assign_14.f90: New test.
* gfortran.dg/pointer_assign_15.f90: New test.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fdca9cc5539..030edc1e5ce 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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
index 00000000000..b06dd841bcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_14.f90
@@ -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
index 00000000000..7c2885910cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_15.f90
@@ -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
