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