MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix PR 94578.

Browse Source 
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.
This commit is contained in:
Thomas König 2020-04-25 12:28:15 +02:00
parent ead1c27a53
commit cf3f7b309f
3 changed files with 43 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/trans-expr.c
View 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). */

19
gcc/testsuite/gfortran.dg/pointer_assign_14.f90 Normal file
View File

@ -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

18
gcc/testsuite/gfortran.dg/pointer_assign_15.f90 Normal file
View File

@ -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