! PR 19239. Check for various kinds of vector subscript. In this test,
|
! PR 19239. Check for various kinds of vector subscript. In this test,
|
! all vector subscripts are indexing single-dimensional arrays.
|
! all vector subscripts are indexing single-dimensional arrays.
|
! { dg-do run }
|
! { dg-do run }
|
program main
|
program main
|
implicit none
|
implicit none
|
integer, parameter :: n = 10
|
integer, parameter :: n = 10
|
integer :: i, j, calls
|
integer :: i, j, calls
|
integer, dimension (n) :: a, b, idx, id
|
integer, dimension (n) :: a, b, idx, id
|
|
|
idx = (/ 3, 1, 5, 2, 4, 10, 8, 7, 6, 9 /)
|
idx = (/ 3, 1, 5, 2, 4, 10, 8, 7, 6, 9 /)
|
id = (/ (i, i = 1, n) /)
|
id = (/ (i, i = 1, n) /)
|
b = (/ (i * 100, i = 1, n) /)
|
b = (/ (i * 100, i = 1, n) /)
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for a simple variable subscript
|
! Tests for a simple variable subscript
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
a (idx) = b
|
a (idx) = b
|
call test (idx, id)
|
call test (idx, id)
|
|
|
a = b (idx)
|
a = b (idx)
|
call test (id, idx)
|
call test (id, idx)
|
|
|
a (idx) = b (idx)
|
a (idx) = b (idx)
|
call test (idx, idx)
|
call test (idx, idx)
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for constant ranges with non-default stride
|
! Tests for constant ranges with non-default stride
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
a (idx (1:7:3)) = b (10:6:-2)
|
a (idx (1:7:3)) = b (10:6:-2)
|
call test (idx (1:7:3), id (10:6:-2))
|
call test (idx (1:7:3), id (10:6:-2))
|
|
|
a (10:6:-2) = b (idx (1:7:3))
|
a (10:6:-2) = b (idx (1:7:3))
|
call test (id (10:6:-2), idx (1:7:3))
|
call test (id (10:6:-2), idx (1:7:3))
|
|
|
a (idx (1:7:3)) = b (idx (1:7:3))
|
a (idx (1:7:3)) = b (idx (1:7:3))
|
call test (idx (1:7:3), idx (1:7:3))
|
call test (idx (1:7:3), idx (1:7:3))
|
|
|
a (idx (1:7:3)) = b (idx (10:6:-2))
|
a (idx (1:7:3)) = b (idx (10:6:-2))
|
call test (idx (1:7:3), idx (10:6:-2))
|
call test (idx (1:7:3), idx (10:6:-2))
|
|
|
a (idx (10:6:-2)) = b (idx (10:6:-2))
|
a (idx (10:6:-2)) = b (idx (10:6:-2))
|
call test (idx (10:6:-2), idx (10:6:-2))
|
call test (idx (10:6:-2), idx (10:6:-2))
|
|
|
a (idx (10:6:-2)) = b (idx (1:7:3))
|
a (idx (10:6:-2)) = b (idx (1:7:3))
|
call test (idx (10:6:-2), idx (1:7:3))
|
call test (idx (10:6:-2), idx (1:7:3))
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for subscripts of the form CONSTRANGE + CONST
|
! Tests for subscripts of the form CONSTRANGE + CONST
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
a (idx (1:5) + 1) = b (1:5)
|
a (idx (1:5) + 1) = b (1:5)
|
call test (idx (1:5) + 1, id (1:5))
|
call test (idx (1:5) + 1, id (1:5))
|
|
|
a (1:5) = b (idx (1:5) + 1)
|
a (1:5) = b (idx (1:5) + 1)
|
call test (id (1:5), idx (1:5) + 1)
|
call test (id (1:5), idx (1:5) + 1)
|
|
|
a (idx (6:10) - 1) = b (idx (1:5) + 1)
|
a (idx (6:10) - 1) = b (idx (1:5) + 1)
|
call test (idx (6:10) - 1, idx (1:5) + 1)
|
call test (idx (6:10) - 1, idx (1:5) + 1)
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for variable subranges
|
! Tests for variable subranges
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
do j = 5, 10
|
do j = 5, 10
|
a (idx (2:j:2)) = b (3:2+j/2)
|
a (idx (2:j:2)) = b (3:2+j/2)
|
call test (idx (2:j:2), id (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))
|
a (3:2+j/2) = b (idx (2:j:2))
|
call test (id (3:2+j/2), 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))
|
a (idx (2:j:2)) = b (idx (2:j:2))
|
call test (idx (2:j:2), idx (2:j:2))
|
call test (idx (2:j:2), idx (2:j:2))
|
end do
|
end do
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for function vectors
|
! Tests for function vectors
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
calls = 0
|
calls = 0
|
|
|
a (foo (5, calls)) = b (2:10:2)
|
a (foo (5, calls)) = b (2:10:2)
|
call test (foo (5, calls), id (2:10:2))
|
call test (foo (5, calls), id (2:10:2))
|
|
|
a (2:10:2) = b (foo (5, calls))
|
a (2:10:2) = b (foo (5, calls))
|
call test (id (2:10:2), foo (5, calls))
|
call test (id (2:10:2), foo (5, calls))
|
|
|
a (foo (5, calls)) = b (foo (5, calls))
|
a (foo (5, calls)) = b (foo (5, calls))
|
call test (foo (5, calls), foo (5, calls))
|
call test (foo (5, calls), foo (5, calls))
|
|
|
if (calls .ne. 8) call abort
|
if (calls .ne. 8) call abort
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for constant vector constructors
|
! Tests for constant vector constructors
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
a ((/ 1, 5, 3, 9 /)) = b (1:4)
|
a ((/ 1, 5, 3, 9 /)) = b (1:4)
|
call test ((/ 1, 5, 3, 9 /), id (1:4))
|
call test ((/ 1, 5, 3, 9 /), id (1:4))
|
|
|
a (1:4) = b ((/ 1, 5, 3, 9 /))
|
a (1:4) = b ((/ 1, 5, 3, 9 /))
|
call test (id (1:4), (/ 1, 5, 3, 9 /))
|
call test (id (1:4), (/ 1, 5, 3, 9 /))
|
|
|
a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /))
|
a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /))
|
call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /))
|
call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /))
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests for variable vector constructors
|
! Tests for variable vector constructors
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
do j = 1, 5
|
do j = 1, 5
|
a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j)
|
a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j)
|
call test ((/ 1, (i + 3, i = 2, j) /), id (1:j))
|
call test ((/ 1, (i + 3, i = 2, j) /), id (1:j))
|
|
|
a (1:j) = b ((/ 1, (i + 3, i = 2, j) /))
|
a (1:j) = b ((/ 1, (i + 3, i = 2, j) /))
|
call test (id (1:j), (/ 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) /))
|
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) /))
|
call test ((/ 1, (i + 3, i = 2, j) /), (/ 8, (i + 2, i = 2, j) /))
|
end do
|
end do
|
|
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
! Tests in which the vector dimension is partnered by a temporary
|
! Tests in which the vector dimension is partnered by a temporary
|
!------------------------------------------------------------------
|
!------------------------------------------------------------------
|
|
|
calls = 0
|
calls = 0
|
a (idx (1:6)) = foo (6, calls)
|
a (idx (1:6)) = foo (6, calls)
|
if (calls .ne. 1) call abort
|
if (calls .ne. 1) call abort
|
do i = 1, 6
|
do i = 1, 6
|
if (a (idx (i)) .ne. i + 3) call abort
|
if (a (idx (i)) .ne. i + 3) call abort
|
end do
|
end do
|
a = 0
|
a = 0
|
|
|
calls = 0
|
calls = 0
|
a (idx (1:6)) = foo (6, calls) * 100
|
a (idx (1:6)) = foo (6, calls) * 100
|
if (calls .ne. 1) call abort
|
if (calls .ne. 1) call abort
|
do i = 1, 6
|
do i = 1, 6
|
if (a (idx (i)) .ne. (i + 3) * 100) call abort
|
if (a (idx (i)) .ne. (i + 3) * 100) call abort
|
end do
|
end do
|
a = 0
|
a = 0
|
|
|
a (idx) = id + 100
|
a (idx) = id + 100
|
do i = 1, n
|
do i = 1, n
|
if (a (idx (i)) .ne. i + 100) call abort
|
if (a (idx (i)) .ne. i + 100) call abort
|
end do
|
end do
|
a = 0
|
a = 0
|
|
|
a (idx (1:10:3)) = (/ 20, 10, 9, 11 /)
|
a (idx (1:10:3)) = (/ 20, 10, 9, 11 /)
|
if (a (idx (1)) .ne. 20) call abort
|
if (a (idx (1)) .ne. 20) call abort
|
if (a (idx (4)) .ne. 10) call abort
|
if (a (idx (4)) .ne. 10) call abort
|
if (a (idx (7)) .ne. 9) call abort
|
if (a (idx (7)) .ne. 9) call abort
|
if (a (idx (10)) .ne. 11) call abort
|
if (a (idx (10)) .ne. 11) call abort
|
a = 0
|
a = 0
|
|
|
contains
|
contains
|
subroutine test (lhs, rhs)
|
subroutine test (lhs, rhs)
|
integer, dimension (:) :: lhs, rhs
|
integer, dimension (:) :: lhs, rhs
|
integer :: i
|
integer :: i
|
|
|
if (size (lhs, 1) .ne. size (rhs, 1)) call abort
|
if (size (lhs, 1) .ne. size (rhs, 1)) call abort
|
do i = 1, size (lhs, 1)
|
do i = 1, size (lhs, 1)
|
if (a (lhs (i)) .ne. b (rhs (i))) call abort
|
if (a (lhs (i)) .ne. b (rhs (i))) call abort
|
end do
|
end do
|
a = 0
|
a = 0
|
end subroutine test
|
end subroutine test
|
|
|
function foo (n, calls)
|
function foo (n, calls)
|
integer :: i, n, calls
|
integer :: i, n, calls
|
integer, dimension (n) :: foo
|
integer, dimension (n) :: foo
|
|
|
calls = calls + 1
|
calls = calls + 1
|
foo = (/ (i + 3, i = 1, n) /)
|
foo = (/ (i + 3, i = 1, n) /)
|
end function foo
|
end function foo
|
end program main
|
end program main
|
|
|
