1! { dg-do run } 2! Test the fix for PR25746, in which dependency checking was not being 3! done for elemental subroutines and therefore for interface assignments. 4! 5! This test is based on 6! http://home.comcast.net/~kmbtib/Fortran_stuff/elem_assign.f90 7! as reported by Harald Anlauf <anlauf@gmx.de> in the PR. 8! 9module elem_assign 10 implicit none 11 type mytype 12 integer x 13 end type mytype 14 interface assignment(=) 15 module procedure myassign 16 end interface assignment(=) 17 contains 18 elemental subroutine myassign(x,y) 19 type(mytype), intent(out) :: x 20 type(mytype), intent(in) :: y 21! Multiply the components by 2 to verify that this is being called. 22 x%x = y%x*2 23 end subroutine myassign 24end module elem_assign 25 26program test 27 use elem_assign 28 implicit none 29 type(mytype) :: y(6), x(6) = (/mytype(1),mytype(20),mytype(300),& 30 mytype(4000),mytype(50000),& 31 mytype(1000000)/) 32 type(mytype) :: z(2, 3) 33! The original case - dependency between lhs and rhs. 34 x = x((/2,3,1,4,5,6/)) 35 if (any(x%x .ne. (/40, 600, 2, 8000, 100000, 2000000/))) call abort () 36! Slightly more elborate case with non-trivial array ref on lhs. 37 x(4:1:-1) = x((/1,3,2,4/)) 38 if (any(x%x .ne. (/16000, 1200, 4, 80, 100000, 2000000/))) call abort () 39! Check that no-dependence case works.... 40 y = x 41 if (any(y%x .ne. (/32000, 2400, 8, 160, 200000, 4000000/))) call abort () 42! ...and now a case that caused headaches during the preparation of the patch 43 x(2:5) = x(1:4) 44 if (any(x%x .ne. (/16000, 32000, 2400, 8, 160, 2000000/))) call abort () 45! Check offsets are done correctly in multi-dimensional cases 46 z = reshape (x, (/2,3/)) 47 z(:, 3:2:-1) = z(:, 1:2) 48 y = reshape (z, (/6/)) 49 if (any(y%x .ne. (/ 64000, 128000, 19200, 64, 128000, 256000/))) call abort () 50end program test 51