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, 9999, 99, 1)
  15    if (any (a .ne. 99)) call abort
  16
  17    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  18    a = eoshift (a, -2, dim = 2)
  19    if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) &
  20       call abort
  21
  22    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  23    a = eoshift (a, -9999, 99, 1)
  24    if (any (a .ne. 99)) call abort
  25
  26    ! Array shift and scalar bound.
  27    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  28    a = eoshift (a, (/1, 0, -1/), 99, 1)
  29    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 99, 7, 8/), (/3, 3/)))) &
  30       call abort
  31
  32    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  33    a = eoshift (a, (/9999, 0, -9999/), 99, 1)
  34    if (any (a .ne. reshape ((/99, 99, 99, 4, 5, 6, 99, 99, 99/), (/3, 3/)))) &
  35       call abort
  36
  37    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  38    a = eoshift (a, (/2, -2, 0/), dim = 2)
  39    if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) &
  40       call abort
  41
  42    ! Scalar shift and array bound.
  43    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  44    a = eoshift (a, 1, (/99, -1, 42/), 1)
  45    if (any (a .ne. reshape ((/2, 3, 99, 5, 6, -1, 8, 9, 42/), (/3, 3/)))) &
  46       call abort
  47
  48    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  49    a = eoshift (a, 9999, (/99, -1, 42/), 1)
  50    if (any (a .ne. reshape ((/99, 99, 99, -1, -1, -1, 42, 42, 42/), &
  51         (/3, 3/)))) call abort
  52
  53    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  54    a = eoshift (a, -9999, (/99, -1, 42/), 1)
  55    if (any (a .ne. reshape ((/99, 99, 99, -1, -1, -1, 42, 42, 42/), &
  56         (/3, 3/)))) call abort
  57
  58    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  59    a = eoshift (a, -2, (/99, -1, 42/), 2)
  60    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
  61       call abort
  62
  63    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  64    bo = (/99, -1, 42/)
  65    a = eoshift (a, -2, bo, 2)
  66    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
  67       call abort
  68
  69    ! Array shift and array bound.
  70    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  71    a = eoshift (a, (/1, 0, -1/), (/99, -1, 42/), 1)
  72    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 42, 7, 8/), (/3, 3/)))) &
  73       call abort
  74
  75    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  76    a = eoshift (a, (/2, -2, 0/), (/99, -1, 42/), 2)
  77    if (any (a .ne. reshape ((/7, -1, 3, 99, -1, 6, 99, 2, 9/), (/3, 3/)))) &
  78       call abort
  79
  80    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  81    sh = (/ 3, -1, -3 /)
  82    bo = (/-999, -99, -9 /)
  83    a = eoshift(a, shift=sh, boundary=bo)
  84    if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), &
  85         shape(a)))) call abort
  86
  87    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  88    a = eoshift (a, (/9999, -9999, 0/), (/99, -1, 42/), 2)
  89    if (any (a .ne. reshape ((/99, -1, 3, 99, -1, 6, 99, -1, 9/), (/3, 3/)))) &
  90       call abort
  91
  92    ! Test arrays > rank 2
  93    b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  94    b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
  95    b = eoshift (b, 1, 99, 1)
  96    if (any (b(:, :, 1) .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) &
  97       call abort
  98    if (any (b(:, :, 2) .ne. reshape ((/12, 13, 99, 15, 16, 99, 18, 19, 99/), (/3, 3/)))) &
  99       call abort
 100
 101    ! TODO: Test array sections
 102 end program