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