diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/vector_subscript_1.f90')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/vector_subscript_1.f90 | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_1.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_1.f90 new file mode 100644 index 000000000..dd09fbb0b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/vector_subscript_1.f90 @@ -0,0 +1,174 @@ +! PR 19239. Check for various kinds of vector subscript. In this test, +! all vector subscripts are indexing single-dimensional arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n = 10 + integer :: i, j, calls + integer, dimension (n) :: a, b, idx, id + + idx = (/ 3, 1, 5, 2, 4, 10, 8, 7, 6, 9 /) + id = (/ (i, i = 1, n) /) + b = (/ (i * 100, i = 1, n) /) + + !------------------------------------------------------------------ + ! Tests for a simple variable subscript + !------------------------------------------------------------------ + + a (idx) = b + call test (idx, id) + + a = b (idx) + call test (id, idx) + + a (idx) = b (idx) + call test (idx, idx) + + !------------------------------------------------------------------ + ! Tests for constant ranges with non-default stride + !------------------------------------------------------------------ + + a (idx (1:7:3)) = b (10:6:-2) + call test (idx (1:7:3), id (10:6:-2)) + + a (10:6:-2) = b (idx (1:7:3)) + call test (id (10:6:-2), idx (1:7:3)) + + a (idx (1:7:3)) = b (idx (1:7:3)) + call test (idx (1:7:3), idx (1:7:3)) + + a (idx (1:7:3)) = b (idx (10:6:-2)) + call test (idx (1:7:3), idx (10:6:-2)) + + a (idx (10:6:-2)) = b (idx (10:6:-2)) + call test (idx (10:6:-2), idx (10:6:-2)) + + a (idx (10:6:-2)) = b (idx (1:7:3)) + call test (idx (10:6:-2), idx (1:7:3)) + + !------------------------------------------------------------------ + ! Tests for subscripts of the form CONSTRANGE + CONST + !------------------------------------------------------------------ + + a (idx (1:5) + 1) = b (1:5) + call test (idx (1:5) + 1, id (1:5)) + + a (1:5) = b (idx (1:5) + 1) + call test (id (1:5), idx (1:5) + 1) + + a (idx (6:10) - 1) = b (idx (1:5) + 1) + call test (idx (6:10) - 1, idx (1:5) + 1) + + !------------------------------------------------------------------ + ! Tests for variable subranges + !------------------------------------------------------------------ + + do j = 5, 10 + a (idx (2:j:2)) = b (3:2+j/2) + call test (idx (2:j:2), id (3:2+j/2)) + + a (3:2+j/2) = b (idx (2:j:2)) + call test (id (3:2+j/2), idx (2:j:2)) + + a (idx (2:j:2)) = b (idx (2:j:2)) + call test (idx (2:j:2), idx (2:j:2)) + end do + + !------------------------------------------------------------------ + ! Tests for function vectors + !------------------------------------------------------------------ + + calls = 0 + + a (foo (5, calls)) = b (2:10:2) + call test (foo (5, calls), id (2:10:2)) + + a (2:10:2) = b (foo (5, calls)) + call test (id (2:10:2), foo (5, calls)) + + a (foo (5, calls)) = b (foo (5, calls)) + call test (foo (5, calls), foo (5, calls)) + + if (calls .ne. 8) call abort + + !------------------------------------------------------------------ + ! Tests for constant vector constructors + !------------------------------------------------------------------ + + a ((/ 1, 5, 3, 9 /)) = b (1:4) + call test ((/ 1, 5, 3, 9 /), id (1:4)) + + a (1:4) = b ((/ 1, 5, 3, 9 /)) + call test (id (1:4), (/ 1, 5, 3, 9 /)) + + a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /)) + call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /)) + + !------------------------------------------------------------------ + ! Tests for variable vector constructors + !------------------------------------------------------------------ + + do j = 1, 5 + a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j) + call test ((/ 1, (i + 3, i = 2, j) /), id (1:j)) + + a (1:j) = b ((/ 1, (i + 3, i = 2, j) /)) + call test (id (1:j), (/ 1, (i + 3, i = 2, j) /)) + + a ((/ 1, (i + 3, i = 2, j) /)) = b ((/ 8, (i + 2, i = 2, j) /)) + call test ((/ 1, (i + 3, i = 2, j) /), (/ 8, (i + 2, i = 2, j) /)) + end do + + !------------------------------------------------------------------ + ! Tests in which the vector dimension is partnered by a temporary + !------------------------------------------------------------------ + + calls = 0 + a (idx (1:6)) = foo (6, calls) + if (calls .ne. 1) call abort + do i = 1, 6 + if (a (idx (i)) .ne. i + 3) call abort + end do + a = 0 + + calls = 0 + a (idx (1:6)) = foo (6, calls) * 100 + if (calls .ne. 1) call abort + do i = 1, 6 + if (a (idx (i)) .ne. (i + 3) * 100) call abort + end do + a = 0 + + a (idx) = id + 100 + do i = 1, n + if (a (idx (i)) .ne. i + 100) call abort + end do + a = 0 + + a (idx (1:10:3)) = (/ 20, 10, 9, 11 /) + if (a (idx (1)) .ne. 20) call abort + if (a (idx (4)) .ne. 10) call abort + if (a (idx (7)) .ne. 9) call abort + if (a (idx (10)) .ne. 11) call abort + a = 0 + +contains + subroutine test (lhs, rhs) + integer, dimension (:) :: lhs, rhs + integer :: i + + if (size (lhs, 1) .ne. size (rhs, 1)) call abort + do i = 1, size (lhs, 1) + if (a (lhs (i)) .ne. b (rhs (i))) call abort + end do + a = 0 + end subroutine test + + function foo (n, calls) + integer :: i, n, calls + integer, dimension (n) :: foo + + calls = calls + 1 + foo = (/ (i + 3, i = 1, n) /) + end function foo +end program main |