This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: PR fortran/19239: Handle general vector subscripts


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]