gcc/testsuite/gfortran.dg/cshift_large_1.f90

   1 ! { dg-do run }
   2 ! { dg-require-effective-target fortran_large_int }
   3 ! Program to test the cshift intrinsic for kind=16 integers
   4 program intrinsic_cshift
   5    integer, parameter :: k=16
   6    integer(kind=k), dimension(3_k, 3_k) :: a
   7    integer(kind=k), dimension(3_k, 3_k, 2_k) :: b
   8
   9    ! Scalar shift
  10    a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
  11    a = cshift (a, 1_k, 1_k)
  12    if (any (a .ne. reshape ((/2_k, 3_k, 1_k, 5_k, 6_k, 4_k, 8_k, 9_k, 7_k/), (/3_k, 3_k/)))) &
  13       call abort
  14
  15    a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
  16    a = cshift (a, -2_k, dim = 2_k)
  17    if (any (a .ne. reshape ((/4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
  18       call abort
  19
  20    ! Array shift
  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 = cshift (a, (/1_k, 0_k, -1_k/))
  23    if (any (a .ne. reshape ((/2_k, 3_k, 1_k, 4_k, 5_k, 6_k, 9_k, 7_k, 8_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 = cshift (a, (/2_k, -2_k, 0_k/), dim = 2_k)
  28    if (any (a .ne. reshape ((/7_k, 5_k, 3_k, 1_k, 8_k, 6_k, 4_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
  29       call abort
  30
  31    ! Test arrays > rank 2
  32    b = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 11_k, 12_k, 13_k, 14_k, 15_k, 16_k, 17_k,&
  33          18_k, 19_k/), (/3_k, 3_k, 2_k/))
  34    b = cshift (b, 1_k)
  35    if (any (b .ne. reshape ((/2_k, 3_k, 1_k, 5_k, 6_k, 4_k, 8_k, 9_k, 7_k, 12_k, 13_k, 11_k, 15_k,&
  36      16_k, 14_k, 18_k, 19_k, 17_k/), (/3_k, 3_k, 2_k/)))) &
  37       call abort
  38
  39    b = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 11_k, 12_k, 13_k, 14_k, 15_k, 16_k, 17_k,&
  40          18_k, 19_k/), (/3_k, 3_k, 2_k/))
  41    b = cshift (b, reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)), 3_k)
  42    if (any (b .ne. reshape ((/11_k, 2_k, 13_k, 4_k, 15_k, 6_k, 17_k, 8_k, 19_k, 1_k, 12_k, 3_k,&
  43      14_k, 5_k, 16_k, 7_k, 18_k, 9_k/), (/3_k, 3_k, 2_k/)))) &
  44       call abort
  45
  46 end program