gcc/testsuite/gfortran.dg/vector_subscript_1.f90

   1 ! PR 19239.  Check for various kinds of vector subscript.  In this test,
   2 ! all vector subscripts are indexing single-dimensional arrays.
   3 ! { dg-do run }
   4 program main
   5   implicit none
   6   integer, parameter :: n = 10
   7   integer :: i, j, calls
   8   integer, dimension (n) :: a, b, idx, id
   9
  10   idx = (/ 3, 1, 5, 2, 4, 10, 8, 7, 6, 9 /)
  11   id = (/ (i, i = 1, n) /)
  12   b = (/ (i * 100, i = 1, n) /)
  13
  14   !------------------------------------------------------------------
  15   ! Tests for a simple variable subscript
  16   !------------------------------------------------------------------
  17
  18   a (idx) = b
  19   call test (idx, id)
  20
  21   a = b (idx)
  22   call test (id, idx)
  23
  24   a (idx) = b (idx)
  25   call test (idx, idx)
  26
  27   !------------------------------------------------------------------
  28   ! Tests for constant ranges with non-default stride
  29   !------------------------------------------------------------------
  30
  31   a (idx (1:7:3)) = b (10:6:-2)
  32   call test (idx (1:7:3), id (10:6:-2))
  33
  34   a (10:6:-2) = b (idx (1:7:3))
  35   call test (id (10:6:-2), idx (1:7:3))
  36
  37   a (idx (1:7:3)) = b (idx (1:7:3))
  38   call test (idx (1:7:3), idx (1:7:3))
  39
  40   a (idx (1:7:3)) = b (idx (10:6:-2))
  41   call test (idx (1:7:3), idx (10:6:-2))
  42
  43   a (idx (10:6:-2)) = b (idx (10:6:-2))
  44   call test (idx (10:6:-2), idx (10:6:-2))
  45
  46   a (idx (10:6:-2)) = b (idx (1:7:3))
  47   call test (idx (10:6:-2), idx (1:7:3))
  48
  49   !------------------------------------------------------------------
  50   ! Tests for subscripts of the form CONSTRANGE + CONST
  51   !------------------------------------------------------------------
  52
  53   a (idx (1:5) + 1) = b (1:5)
  54   call test (idx (1:5) + 1, id (1:5))
  55
  56   a (1:5) = b (idx (1:5) + 1)
  57   call test (id (1:5), idx (1:5) + 1)
  58
  59   a (idx (6:10) - 1) = b (idx (1:5) + 1)
  60   call test (idx (6:10) - 1, idx (1:5) + 1)
  61
  62   !------------------------------------------------------------------
  63   ! Tests for variable subranges
  64   !------------------------------------------------------------------
  65
  66   do j = 5, 10
  67     a (idx (2:j:2)) = b (3:2+j/2)
  68     call test (idx (2:j:2), id (3:2+j/2))
  69
  70     a (3:2+j/2) = b (idx (2:j:2))
  71     call test (id (3:2+j/2), idx (2:j:2))
  72
  73     a (idx (2:j:2)) = b (idx (2:j:2))
  74     call test (idx (2:j:2), idx (2:j:2))
  75   end do
  76
  77   !------------------------------------------------------------------
  78   ! Tests for function vectors
  79   !------------------------------------------------------------------
  80
  81   calls = 0
  82
  83   a (foo (5, calls)) = b (2:10:2)
  84   call test (foo (5, calls), id (2:10:2))
  85
  86   a (2:10:2) = b (foo (5, calls))
  87   call test (id (2:10:2), foo (5, calls))
  88
  89   a (foo (5, calls)) = b (foo (5, calls))
  90   call test (foo (5, calls), foo (5, calls))
  91
  92   if (calls .ne. 8) STOP 1
  93
  94   !------------------------------------------------------------------
  95   ! Tests for constant vector constructors
  96   !------------------------------------------------------------------
  97
  98   a ((/ 1, 5, 3, 9 /)) = b (1:4)
  99   call test ((/ 1, 5, 3, 9 /), id (1:4))
 100
 101   a (1:4) = b ((/ 1, 5, 3, 9 /))
 102   call test (id (1:4), (/ 1, 5, 3, 9 /))
 103
 104   a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /))
 105   call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /))
 106
 107   !------------------------------------------------------------------
 108   ! Tests for variable vector constructors
 109   !------------------------------------------------------------------
 110
 111   do j = 1, 5
 112     a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j)
 113     call test ((/ 1, (i + 3, i = 2, j) /), id (1:j))
 114
 115     a (1:j) = b ((/ 1, (i + 3, i = 2, j) /))
 116     call test (id (1:j), (/ 1, (i + 3, i = 2, j) /))
 117
 118     a ((/ 1, (i + 3, i = 2, j) /)) = b ((/ 8, (i + 2, i = 2, j) /))
 119     call test ((/ 1, (i + 3, i = 2, j) /), (/ 8, (i + 2, i = 2, j) /))
 120   end do
 121
 122   !------------------------------------------------------------------
 123   ! Tests in which the vector dimension is partnered by a temporary
 124   !------------------------------------------------------------------
 125
 126   calls = 0
 127   a (idx (1:6)) = foo (6, calls)
 128   if (calls .ne. 1) STOP 2
 129   do i = 1, 6
 130     if (a (idx (i)) .ne. i + 3) STOP 3
 131   end do
 132   a = 0
 133
 134   calls = 0
 135   a (idx (1:6)) = foo (6, calls) * 100
 136   if (calls .ne. 1) STOP 4
 137   do i = 1, 6
 138     if (a (idx (i)) .ne. (i + 3) * 100) STOP 5
 139   end do
 140   a = 0
 141
 142   a (idx) = id + 100
 143   do i = 1, n
 144     if (a (idx (i)) .ne. i + 100) STOP 6
 145   end do
 146   a = 0
 147
 148   a (idx (1:10:3)) = (/ 20, 10, 9, 11 /)
 149   if (a (idx (1)) .ne. 20) STOP 7
 150   if (a (idx (4)) .ne. 10) STOP 8
 151   if (a (idx (7)) .ne. 9) STOP 9
 152   if (a (idx (10)) .ne. 11) STOP 10
 153   a = 0
 154
 155 contains
 156   subroutine test (lhs, rhs)
 157     integer, dimension (:) :: lhs, rhs
 158     integer :: i
 159
 160     if (size (lhs, 1) .ne. size (rhs, 1)) STOP 11
 161     do i = 1, size (lhs, 1)
 162       if (a (lhs (i)) .ne. b (rhs (i))) STOP 12
 163     end do
 164     a = 0
 165   end subroutine test
 166
 167   function foo (n, calls)
 168     integer :: i, n, calls
 169     integer, dimension (n) :: foo
 170
 171     calls = calls + 1
 172     foo = (/ (i + 3, i = 1, n) /)
 173   end function foo
 174 end program main