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