This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: PR fortran/19239: Handle general vector subscripts
- From: Richard Sandiford <richard at codesourcery dot com>
- To: Paul Brook <paul at codesourcery dot com>
- Cc: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Fri, 09 Sep 2005 07:37:03 +0100
- Subject: Re: PR fortran/19239: Handle general vector subscripts
- References: <87aciqscav.fsf@talisman.home><200509082150.15266.paul@codesourcery.com>
Paul Brook <paul@codesourcery.com> writes:
>> gcc/fortran/
>> PR fortran/19239
>> [...]
>
> Ok.
Thanks. For the record, here's the revised testsuite patch (now committed).
Richard
PR fortran/19239
* gfortran.dg/vector_subscript_1.f90,
* gfortran.dg/vector_subscript_2.f90: New tests.
diff -c /dev/null gcc/testsuite/gfortran.dg/vector_subscript_1.f90
*** /dev/null 2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/vector_subscript_1.f90 2005-09-09 07:27:38.000000000 +0100
***************
*** 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
diff -c /dev/null gcc/testsuite/gfortran.dg/vector_subscript_2.f90
*** /dev/null 2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/vector_subscript_2.f90 2005-09-09 07:28:20.000000000 +0100
***************
*** 0 ****
--- 1,39 ----
+ ! Like vector_subscript_1.f90, but check subscripts in multi-dimensional
+ ! arrays.
+ ! { dg-do run }
+ program main
+ implicit none
+ integer, parameter :: n = 5
+ integer :: i1, i2, i3
+ integer, dimension (n, n, n) :: a, b
+ integer, dimension (n) :: idx, id
+
+ idx = (/ 3, 1, 5, 2, 4 /)
+ id = (/ (i1, i1 = 1, n) /)
+ forall (i1 = 1:n, i2 = 1:n, i3 = 1:n)
+ b (i1, i2, i3) = i1 + i2 * 10 + i3 * 100
+ end forall
+
+ i1 = 5
+ a (foo (i1), 1, :) = b (2, :, foo (i1))
+ do i1 = 1, 5
+ do i2 = 1, 5
+ if (a (idx (i1), 1, i2) .ne. b (2, i1, idx (i2))) call abort
+ end do
+ end do
+ a = 0
+
+ a (1, idx (1:4), 2:4) = b (2:5, idx (3:5), 2)
+ do i1 = 1, 4
+ do i2 = 1, 3
+ if (a (1, idx (i1), 1 + i2) .ne. b (1 + i1, idx (i2 + 2), 2)) call abort
+ end do
+ end do
+ a = 0
+ contains
+ function foo (n)
+ integer :: n
+ integer, dimension (n) :: foo
+ foo = idx (1:n)
+ end function foo
+ end program main