1 ! PR 19239. Check for various kinds of vector subscript. In this test,
2 ! all vector subscripts are indexing single-dimensional arrays.
6 integer, parameter :: n = 10
8 integer, dimension (n) :: a, b, idx, id
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) /)
14 !------------------------------------------------------------------
15 ! Tests for a simple variable subscript
16 !------------------------------------------------------------------
27 !------------------------------------------------------------------
28 ! Tests for constant ranges with non-default stride
29 !------------------------------------------------------------------
31 a (idx (1:7:3)) = b (10:6:-2)
32 call test (idx (1:7:3), id (10:6:-2))
34 a (10:6:-2) = b (idx (1:7:3))
35 call test (id (10:6:-2), idx (1:7:3))
37 a (idx (1:7:3)) = b (idx (1:7:3))
38 call test (idx (1:7:3), idx (1:7:3))
40 a (idx (1:7:3)) = b (idx (10:6:-2))
41 call test (idx (1:7:3), idx (10:6:-2))
43 a (idx (10:6:-2)) = b (idx (10:6:-2))
44 call test (idx (10:6:-2), idx (10:6:-2))
46 a (idx (10:6:-2)) = b (idx (1:7:3))
47 call test (idx (10:6:-2), idx (1:7:3))
49 !------------------------------------------------------------------
50 ! Tests for subscripts of the form CONSTRANGE + CONST
51 !------------------------------------------------------------------
53 a (idx (1:5) + 1) = b (1:5)
54 call test (idx (1:5) + 1, id (1:5))
56 a (1:5) = b (idx (1:5) + 1)
57 call test (id (1:5), idx (1:5) + 1)
59 a (idx (6:10) - 1) = b (idx (1:5) + 1)
60 call test (idx (6:10) - 1, idx (1:5) + 1)
62 !------------------------------------------------------------------
63 ! Tests for variable subranges
64 !------------------------------------------------------------------
67 a (idx (2:j:2)) = b (3:2+j/2)
68 call test (idx (2:j:2), id (3:2+j/2))
70 a (3:2+j/2) = b (idx (2:j:2))
71 call test (id (3:2+j/2), idx (2:j:2))
73 a (idx (2:j:2)) = b (idx (2:j:2))
74 call test (idx (2:j:2), idx (2:j:2))
77 !------------------------------------------------------------------
78 ! Tests for function vectors
79 !------------------------------------------------------------------
83 a (foo (5, calls)) = b (2:10:2)
84 call test (foo (5, calls), id (2:10:2))
86 a (2:10:2) = b (foo (5, calls))
87 call test (id (2:10:2), foo (5, calls))
89 a (foo (5, calls)) = b (foo (5, calls))
90 call test (foo (5, calls), foo (5, calls))
92 if (calls .ne. 8) call abort
94 !------------------------------------------------------------------
95 ! Tests for constant vector constructors
96 !------------------------------------------------------------------
98 a ((/ 1, 5, 3, 9 /)) = b (1:4)
99 call test ((/ 1, 5, 3, 9 /), id (1:4))
101 a (1:4) = b ((/ 1, 5, 3, 9 /))
102 call test (id (1:4), (/ 1, 5, 3, 9 /))
104 a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /))
105 call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /))
107 !------------------------------------------------------------------
108 ! Tests for variable vector constructors
109 !------------------------------------------------------------------
112 a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j)
113 call test ((/ 1, (i + 3, i = 2, j) /), id (1:j))
115 a (1:j) = b ((/ 1, (i + 3, i = 2, j) /))
116 call test (id (1:j), (/ 1, (i + 3, i = 2, j) /))
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) /))
122 !------------------------------------------------------------------
123 ! Tests in which the vector dimension is partnered by a temporary
124 !------------------------------------------------------------------
127 a (idx (1:6)) = foo (6, calls)
128 if (calls .ne. 1) call abort
130 if (a (idx (i)) .ne. i + 3) call abort
135 a (idx (1:6)) = foo (6, calls) * 100
136 if (calls .ne. 1) call abort
138 if (a (idx (i)) .ne. (i + 3) * 100) call abort
144 if (a (idx (i)) .ne. i + 100) call abort
148 a (idx (1:10:3)) = (/ 20, 10, 9, 11 /)
149 if (a (idx (1)) .ne. 20) call abort
150 if (a (idx (4)) .ne. 10) call abort
151 if (a (idx (7)) .ne. 9) call abort
152 if (a (idx (10)) .ne. 11) call abort
156 subroutine test (lhs, rhs)
157 integer, dimension (:) :: lhs, rhs
160 if (size (lhs, 1) .ne. size (rhs, 1)) call abort
161 do i = 1, size (lhs, 1)
162 if (a (lhs (i)) .ne. b (rhs (i))) call abort
167 function foo (n, calls)
168 integer :: i, n, calls
169 integer, dimension (n) :: foo
172 foo = (/ (i + 3, i = 1, n) /)