! { dg-do run }
|
! { dg-do run }
|
! Test the fix for PR25746, in which dependency checking was not being
|
! Test the fix for PR25746, in which dependency checking was not being
|
! done for elemental subroutines and therefore for interface assignments.
|
! done for elemental subroutines and therefore for interface assignments.
|
!
|
!
|
! This test is based on
|
! This test is based on
|
! http://home.comcast.net/~kmbtib/Fortran_stuff/elem_assign.f90
|
! http://home.comcast.net/~kmbtib/Fortran_stuff/elem_assign.f90
|
! as reported by Harald Anlauf in the PR.
|
! as reported by Harald Anlauf in the PR.
|
!
|
!
|
module elem_assign
|
module elem_assign
|
implicit none
|
implicit none
|
type mytype
|
type mytype
|
integer x
|
integer x
|
end type mytype
|
end type mytype
|
interface assignment(=)
|
interface assignment(=)
|
module procedure myassign
|
module procedure myassign
|
end interface assignment(=)
|
end interface assignment(=)
|
contains
|
contains
|
elemental subroutine myassign(x,y)
|
elemental subroutine myassign(x,y)
|
type(mytype), intent(out) :: x
|
type(mytype), intent(out) :: x
|
type(mytype), intent(in) :: y
|
type(mytype), intent(in) :: y
|
! Multiply the components by 2 to verify that this is being called.
|
! Multiply the components by 2 to verify that this is being called.
|
x%x = y%x*2
|
x%x = y%x*2
|
end subroutine myassign
|
end subroutine myassign
|
end module elem_assign
|
end module elem_assign
|
|
|
program test
|
program test
|
use elem_assign
|
use elem_assign
|
implicit none
|
implicit none
|
type(mytype) :: y(6), x(6) = (/mytype(1),mytype(20),mytype(300),&
|
type(mytype) :: y(6), x(6) = (/mytype(1),mytype(20),mytype(300),&
|
mytype(4000),mytype(50000),&
|
mytype(4000),mytype(50000),&
|
mytype(1000000)/)
|
mytype(1000000)/)
|
type(mytype) :: z(2, 3)
|
type(mytype) :: z(2, 3)
|
! The original case - dependency between lhs and rhs.
|
! The original case - dependency between lhs and rhs.
|
x = x((/2,3,1,4,5,6/))
|
x = x((/2,3,1,4,5,6/))
|
if (any(x%x .ne. (/40, 600, 2, 8000, 100000, 2000000/))) call abort ()
|
if (any(x%x .ne. (/40, 600, 2, 8000, 100000, 2000000/))) call abort ()
|
! Slightly more elborate case with non-trivial array ref on lhs.
|
! Slightly more elborate case with non-trivial array ref on lhs.
|
x(4:1:-1) = x((/1,3,2,4/))
|
x(4:1:-1) = x((/1,3,2,4/))
|
if (any(x%x .ne. (/16000, 1200, 4, 80, 100000, 2000000/))) call abort ()
|
if (any(x%x .ne. (/16000, 1200, 4, 80, 100000, 2000000/))) call abort ()
|
! Check that no-dependence case works....
|
! Check that no-dependence case works....
|
y = x
|
y = x
|
if (any(y%x .ne. (/32000, 2400, 8, 160, 200000, 4000000/))) call abort ()
|
if (any(y%x .ne. (/32000, 2400, 8, 160, 200000, 4000000/))) call abort ()
|
! ...and now a case that caused headaches during the preparation of the patch
|
! ...and now a case that caused headaches during the preparation of the patch
|
x(2:5) = x(1:4)
|
x(2:5) = x(1:4)
|
if (any(x%x .ne. (/16000, 32000, 2400, 8, 160, 2000000/))) call abort ()
|
if (any(x%x .ne. (/16000, 32000, 2400, 8, 160, 2000000/))) call abort ()
|
! Check offsets are done correctly in multi-dimensional cases
|
! Check offsets are done correctly in multi-dimensional cases
|
z = reshape (x, (/2,3/))
|
z = reshape (x, (/2,3/))
|
z(:, 3:2:-1) = z(:, 1:2)
|
z(:, 3:2:-1) = z(:, 1:2)
|
y = reshape (z, (/6/))
|
y = reshape (z, (/6/))
|
if (any(y%x .ne. (/ 64000, 128000, 19200, 64, 128000, 256000/))) call abort ()
|
if (any(y%x .ne. (/ 64000, 128000, 19200, 64, 128000, 256000/))) call abort ()
|
end program test
|
end program test
|
|
|
! { dg-final { cleanup-modules "elem_assign" } }
|
! { dg-final { cleanup-modules "elem_assign" } }
|
|
|
|
|
