gcc/testsuite/gfortran.dg/eoshift_large_1.f90

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