gcc/testsuite/gfortran.dg/vector_subscript_2.f90

   1 ! Like vector_subscript_1.f90, but check subscripts in multi-dimensional
   2 ! arrays.
   3 ! { dg-do run }
   4 program main
   5   implicit none
   6   integer, parameter :: n = 5
   7   integer :: i1, i2, i3
   8   integer, dimension (n, n, n) :: a, b
   9   integer, dimension (n) :: idx, id
  10
  11   idx = (/ 3, 1, 5, 2, 4 /)
  12   id = (/ (i1, i1 = 1, n) /)
  13   forall (i1 = 1:n, i2 = 1:n, i3 = 1:n)
  14     b (i1, i2, i3) = i1 + i2 * 10 + i3 * 100
  15   end forall
  16
  17   i1 = 5
  18   a (foo (i1), 1, :) = b (2, :, foo (i1))
  19   do i1 = 1, 5
  20     do i2 = 1, 5
  21       if (a (idx (i1), 1, i2) .ne. b (2, i1, idx (i2))) STOP 1
  22     end do
  23   end do
  24   a = 0
  25
  26   a (1, idx (1:4), 2:4) = b (2:5, idx (3:5), 2)
  27   do i1 = 1, 4
  28     do i2 = 1, 3
  29       if (a (1, idx (i1), 1 + i2) .ne. b (1 + i1, idx (i2 + 2), 2)) STOP 2
  30     end do
  31   end do
  32   a = 0
  33 contains
  34   function foo (n)
  35     integer :: n
  36     integer, dimension (n) :: foo
  37     foo = idx (1:n)
  38   end function foo
  39 end program main