1! PR 19239.  Check for various kinds of vector subscript.  In this test,
2! all vector subscripts are indexing single-dimensional arrays.
3! { dg-do run }
4program main
5  implicit none
6  integer, parameter :: n = 10
7  integer :: i, j, calls
8  integer, dimension (n) :: a, b, idx, id
9
10  idx = (/ 3, 1, 5, 2, 4, 10, 8, 7, 6, 9 /)
11  id = (/ (i, i = 1, n) /)
12  b = (/ (i * 100, i = 1, n) /)
13
14  !------------------------------------------------------------------
15  ! Tests for a simple variable subscript
16  !------------------------------------------------------------------
17
18  a (idx) = b
19  call test (idx, id)
20
21  a = b (idx)
22  call test (id, idx)
23
24  a (idx) = b (idx)
25  call test (idx, idx)
26
27  !------------------------------------------------------------------
28  ! Tests for constant ranges with non-default stride
29  !------------------------------------------------------------------
30
31  a (idx (1:7:3)) = b (10:6:-2)
32  call test (idx (1:7:3), id (10:6:-2))
33
34  a (10:6:-2) = b (idx (1:7:3))
35  call test (id (10:6:-2), idx (1:7:3))
36
37  a (idx (1:7:3)) = b (idx (1:7:3))
38  call test (idx (1:7:3), idx (1:7:3))
39
40  a (idx (1:7:3)) = b (idx (10:6:-2))
41  call test (idx (1:7:3), idx (10:6:-2))
42
43  a (idx (10:6:-2)) = b (idx (10:6:-2))
44  call test (idx (10:6:-2), idx (10:6:-2))
45
46  a (idx (10:6:-2)) = b (idx (1:7:3))
47  call test (idx (10:6:-2), idx (1:7:3))
48
49  !------------------------------------------------------------------
50  ! Tests for subscripts of the form CONSTRANGE + CONST
51  !------------------------------------------------------------------
52
53  a (idx (1:5) + 1) = b (1:5)
54  call test (idx (1:5) + 1, id (1:5))
55
56  a (1:5) = b (idx (1:5) + 1)
57  call test (id (1:5), idx (1:5) + 1)
58
59  a (idx (6:10) - 1) = b (idx (1:5) + 1)
60  call test (idx (6:10) - 1, idx (1:5) + 1)
61
62  !------------------------------------------------------------------
63  ! Tests for variable subranges
64  !------------------------------------------------------------------
65
66  do j = 5, 10
67    a (idx (2:j:2)) = b (3:2+j/2)
68    call test (idx (2:j:2), id (3:2+j/2))
69
70    a (3:2+j/2) = b (idx (2:j:2))
71    call test (id (3:2+j/2), idx (2:j:2))
72
73    a (idx (2:j:2)) = b (idx (2:j:2))
74    call test (idx (2:j:2), idx (2:j:2))
75  end do
76
77  !------------------------------------------------------------------
78  ! Tests for function vectors
79  !------------------------------------------------------------------
80
81  calls = 0
82
83  a (foo (5, calls)) = b (2:10:2)
84  call test (foo (5, calls), id (2:10:2))
85
86  a (2:10:2) = b (foo (5, calls))
87  call test (id (2:10:2), foo (5, calls))
88
89  a (foo (5, calls)) = b (foo (5, calls))
90  call test (foo (5, calls), foo (5, calls))
91
92  if (calls .ne. 8) STOP 1
93
94  !------------------------------------------------------------------
95  ! Tests for constant vector constructors
96  !------------------------------------------------------------------
97
98  a ((/ 1, 5, 3, 9 /)) = b (1:4)
99  call test ((/ 1, 5, 3, 9 /), id (1:4))
100
101  a (1:4) = b ((/ 1, 5, 3, 9 /))
102  call test (id (1:4), (/ 1, 5, 3, 9 /))
103
104  a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /))
105  call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /))
106
107  !------------------------------------------------------------------
108  ! Tests for variable vector constructors
109  !------------------------------------------------------------------
110
111  do j = 1, 5
112    a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j)
113    call test ((/ 1, (i + 3, i = 2, j) /), id (1:j))
114
115    a (1:j) = b ((/ 1, (i + 3, i = 2, j) /))
116    call test (id (1:j), (/ 1, (i + 3, i = 2, j) /))
117
118    a ((/ 1, (i + 3, i = 2, j) /)) = b ((/ 8, (i + 2, i = 2, j) /))
119    call test ((/ 1, (i + 3, i = 2, j) /), (/ 8, (i + 2, i = 2, j) /))
120  end do
121
122  !------------------------------------------------------------------
123  ! Tests in which the vector dimension is partnered by a temporary
124  !------------------------------------------------------------------
125
126  calls = 0
127  a (idx (1:6)) = foo (6, calls)
128  if (calls .ne. 1) STOP 2
129  do i = 1, 6
130    if (a (idx (i)) .ne. i + 3) STOP 3
131  end do
132  a = 0
133
134  calls = 0
135  a (idx (1:6)) = foo (6, calls) * 100
136  if (calls .ne. 1) STOP 4
137  do i = 1, 6
138    if (a (idx (i)) .ne. (i + 3) * 100) STOP 5
139  end do
140  a = 0
141
142  a (idx) = id + 100
143  do i = 1, n
144    if (a (idx (i)) .ne. i + 100) STOP 6
145  end do
146  a = 0
147
148  a (idx (1:10:3)) = (/ 20, 10, 9, 11 /)
149  if (a (idx (1)) .ne. 20) STOP 7
150  if (a (idx (4)) .ne. 10) STOP 8
151  if (a (idx (7)) .ne. 9) STOP 9
152  if (a (idx (10)) .ne. 11) STOP 10
153  a = 0
154
155contains
156  subroutine test (lhs, rhs)
157    integer, dimension (:) :: lhs, rhs
158    integer :: i
159
160    if (size (lhs, 1) .ne. size (rhs, 1)) STOP 11
161    do i = 1, size (lhs, 1)
162      if (a (lhs (i)) .ne. b (rhs (i))) STOP 12
163    end do
164    a = 0
165  end subroutine test
166
167  function foo (n, calls)
168    integer :: i, n, calls
169    integer, dimension (n) :: foo
170
171    calls = calls + 1
172    foo = (/ (i + 3, i = 1, n) /)
173  end function foo
174end program main
175