old-autovect-branch/gcc/testsuite/gfortran.fortran-torture/execute/forall_1.f90

   1 ! Program to test FORALL construct
   2 program forall_1
   3
   4    call actual_variable ()
   5    call negative_stride ()
   6    call forall_index ()
   7
   8 contains
   9    subroutine actual_variable ()
  10       integer:: x = -1
  11       integer a(3,4)
  12       j = 100
  13
  14       ! Actual variable 'x' and 'j' used as FORALL index
  15       forall (x = 1:3, j = 1:4)
  16          a (x,j) = j
  17       end forall
  18       if (any (a.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort
  19       if ((x.ne.-1).or.(j.ne.100)) call abort
  20
  21       call actual_variable_2 (x, j, a)
  22    end subroutine
  23
  24    subroutine actual_variable_2(x, j, a)
  25       integer x,j,x1,j1
  26       integer a(3,4), b(3,4)
  27
  28       ! Actual variable 'x' and 'j' used as FORALL index.
  29       forall (x=3:1:-1, j=4:1:-1)
  30          a(x,j) = j
  31          b(x,j) = j
  32       end forall
  33
  34       if (any (a.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort
  35       if (any (b.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort
  36       if ((x.ne.-1).or.(j.ne.100)) call abort
  37    end subroutine
  38
  39    subroutine negative_stride ()
  40       integer a(3,4)
  41       integer x, j
  42
  43       ! FORALL with negative stride
  44       forall (x = 3:1:-1, j = 4:1:-1)
  45          a(x,j) = j + x
  46       end forall
  47       if (any (a.ne.reshape ((/2,3,4,3,4,5,4,5,6,5,6,7/), (/3,4/)))) call abort
  48    end subroutine
  49
  50    subroutine forall_index
  51       integer a(32,32)
  52
  53       ! FORALL with arbitrary number indexes
  54       forall (i1=1:2,i2=1:2,i3=1:2,i4=1:2,i5=1:2,i6=1:2,i7=1:2,i8=1:2,i9=1:2,&
  55               i10=1:2)
  56          a(i1+2*i3+4*i5+8*i7+16*i9-30,i2+2*i4+4*i6+8*i8+16*i10-30) = 1
  57       end forall
  58       if ((a(5,5).ne.1).or. (a(32,32).ne.1)) call abort
  59    end subroutine
  60
  61 end