gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_eoshift.f90

   1 ! Program to test the eoshift intrinsic
   2 program intrinsic_eoshift
   3    integer, dimension(3, 3) :: a
   4    integer, dimension(3, 3, 2) :: b
   5    integer, dimension(3) :: bo, sh
   6
   7    ! Scalar shift and scalar bound.
   8    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
   9    a = eoshift (a, 1, 99, 1)
  10    if (any (a .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) &
  11       call abort
  12
  13    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  14    a = eoshift (a, -2, dim = 2)
  15    if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) &
  16       call abort
  17
  18    ! Array shift and scalar bound.
  19    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  20    a = eoshift (a, (/1, 0, -1/), 99, 1)
  21    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 99, 7, 8/), (/3, 3/)))) &
  22       call abort
  23
  24    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  25    a = eoshift (a, (/2, -2, 0/), dim = 2)
  26    if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) &
  27       call abort
  28
  29    ! Scalar shift and array bound.
  30    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  31    a = eoshift (a, 1, (/99, -1, 42/), 1)
  32    if (any (a .ne. reshape ((/2, 3, 99, 5, 6, -1, 8, 9, 42/), (/3, 3/)))) &
  33       call abort
  34
  35    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  36    a = eoshift (a, -2, (/99, -1, 42/), 2)
  37    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
  38       call abort
  39
  40    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  41    bo = (/99, -1, 42/)
  42    a = eoshift (a, -2, bo, 2)
  43    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
  44       call abort
  45
  46    ! Array shift and array bound.
  47    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  48    a = eoshift (a, (/1, 0, -1/), (/99, -1, 42/), 1)
  49    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 42, 7, 8/), (/3, 3/)))) &
  50       call abort
  51
  52    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  53    a = eoshift (a, (/2, -2, 0/), (/99, -1, 42/), 2)
  54    if (any (a .ne. reshape ((/7, -1, 3, 99, -1, 6, 99, 2, 9/), (/3, 3/)))) &
  55       call abort
  56
  57    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  58    sh = (/ 3, -1, -3 /)
  59    bo = (/-999, -99, -9 /)
  60    a = eoshift(a, shift=sh, boundary=bo)
  61    if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), &
  62         shape(a)))) call abort
  63
  64    ! Test arrays > rank 2
  65    b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  66    b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  67    b = eoshift (b, 1, 99, 1)
  68    if (any (b(:, :, 1) .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) &
  69       call abort
  70    if (any (b(:, :, 2) .ne. reshape ((/12, 13, 99, 15, 16, 99, 18, 19, 99/), (/3, 3/)))) &
  71       call abort
  72
  73    ! TODO: Test array sections
  74 end program