gcc/testsuite/gfortran.dg/shiftalr_1.F90

   1 ! Test the SHIFTA, SHIFTL and SHIFTR intrinsics.
   2 !
   3 ! { dg-do run }
   4 ! { dg-options "-ffree-line-length-none" }
   5
   6   interface run_shifta
   7     procedure shifta_1
   8     procedure shifta_2
   9     procedure shifta_4
  10     procedure shifta_8
  11   end interface
  12   interface run_shiftl
  13     procedure shiftl_1
  14     procedure shiftl_2
  15     procedure shiftl_4
  16     procedure shiftl_8
  17   end interface
  18   interface run_shiftr
  19     procedure shiftr_1
  20     procedure shiftr_2
  21     procedure shiftr_4
  22     procedure shiftr_8
  23   end interface
  24   interface run_ishft
  25     procedure ishft_1
  26     procedure ishft_2
  27     procedure ishft_4
  28     procedure ishft_8
  29   end interface
  30
  31 #define CHECK(I,SHIFT,RESA,RESL,RESR) \
  32   if (shifta(I,SHIFT) /= RESA) call abort ; \
  33   if (shiftr(I,SHIFT) /= RESR) call abort ; \
  34   if (shiftl(I,SHIFT) /= RESL) call abort ; \
  35   if (run_shifta(I,SHIFT) /= RESA) call abort ; \
  36   if (run_shiftr(I,SHIFT) /= RESR) call abort ; \
  37   if (run_shiftl(I,SHIFT) /= RESL) call abort ; \
  38   if (ishft(I,SHIFT) /= RESL) call abort ; \
  39   if (ishft(I,-SHIFT) /= RESR) call abort ; \
  40   if (run_ishft(I,SHIFT) /= RESL) call abort ; \
  41   if (run_ishft(I,-SHIFT) /= RESR) call abort
  42
  43   CHECK(0_1,0,0_1,0_1,0_1)
  44   CHECK(11_1,0,11_1,11_1,11_1)
  45   CHECK(-11_1,0,-11_1,-11_1,-11_1)
  46   CHECK(0_1,1,0_1,0_1,0_1)
  47   CHECK(11_1,1,5_1,22_1,5_1)
  48   CHECK(11_1,2,2_1,44_1,2_1)
  49   CHECK(-11_1,1,-6_1,-22_1,huge(0_1)-5_1)
  50
  51   CHECK(0_2,0,0_2,0_2,0_2)
  52   CHECK(11_2,0,11_2,11_2,11_2)
  53   CHECK(-11_2,0,-11_2,-11_2,-11_2)
  54   CHECK(0_2,1,0_2,0_2,0_2)
  55   CHECK(11_2,1,5_2,22_2,5_2)
  56   CHECK(11_2,2,2_2,44_2,2_2)
  57   CHECK(-11_2,1,-6_2,-22_2,huge(0_2)-5_2)
  58
  59   CHECK(0_4,0,0_4,0_4,0_4)
  60   CHECK(11_4,0,11_4,11_4,11_4)
  61   CHECK(-11_4,0,-11_4,-11_4,-11_4)
  62   CHECK(0_4,1,0_4,0_4,0_4)
  63   CHECK(11_4,1,5_4,22_4,5_4)
  64   CHECK(11_4,2,2_4,44_4,2_4)
  65   CHECK(-11_4,1,-6_4,-22_4,huge(0_4)-5_4)
  66
  67   CHECK(0_8,0,0_8,0_8,0_8)
  68   CHECK(11_8,0,11_8,11_8,11_8)
  69   CHECK(-11_8,0,-11_8,-11_8,-11_8)
  70   CHECK(0_8,1,0_8,0_8,0_8)
  71   CHECK(11_8,1,5_8,22_8,5_8)
  72   CHECK(11_8,2,2_8,44_8,2_8)
  73   CHECK(-11_8,1,-6_8,-22_8,huge(0_8)-5_8)
  74
  75 contains
  76
  77   function shifta_1 (i, shift) result(res)
  78     integer(kind=1) :: i, res
  79     integer :: shift
  80     res = shifta(i,shift)
  81   end function
  82   function shiftl_1 (i, shift) result(res)
  83     integer(kind=1) :: i, res
  84     integer :: shift
  85     res = shiftl(i,shift)
  86   end function
  87   function shiftr_1 (i, shift) result(res)
  88     integer(kind=1) :: i, res
  89     integer :: shift
  90     res = shiftr(i,shift)
  91   end function
  92
  93   function shifta_2 (i, shift) result(res)
  94     integer(kind=2) :: i, res
  95     integer :: shift
  96     res = shifta(i,shift)
  97   end function
  98   function shiftl_2 (i, shift) result(res)
  99     integer(kind=2) :: i, res
 100     integer :: shift
 101     res = shiftl(i,shift)
 102   end function
 103   function shiftr_2 (i, shift) result(res)
 104     integer(kind=2) :: i, res
 105     integer :: shift
 106     res = shiftr(i,shift)
 107   end function
 108
 109   function shifta_4 (i, shift) result(res)
 110     integer(kind=4) :: i, res
 111     integer :: shift
 112     res = shifta(i,shift)
 113   end function
 114   function shiftl_4 (i, shift) result(res)
 115     integer(kind=4) :: i, res
 116     integer :: shift
 117     res = shiftl(i,shift)
 118   end function
 119   function shiftr_4 (i, shift) result(res)
 120     integer(kind=4) :: i, res
 121     integer :: shift
 122     res = shiftr(i,shift)
 123   end function
 124
 125   function shifta_8 (i, shift) result(res)
 126     integer(kind=8) :: i, res
 127     integer :: shift
 128     res = shifta(i,shift)
 129   end function
 130   function shiftl_8 (i, shift) result(res)
 131     integer(kind=8) :: i, res
 132     integer :: shift
 133     res = shiftl(i,shift)
 134   end function
 135   function shiftr_8 (i, shift) result(res)
 136     integer(kind=8) :: i, res
 137     integer :: shift
 138     res = shiftr(i,shift)
 139   end function
 140
 141   function ishft_1 (i, shift) result(res)
 142     integer(kind=1) :: i, res
 143     integer :: shift
 144     res = ishft(i,shift)
 145   end function
 146   function ishft_2 (i, shift) result(res)
 147     integer(kind=2) :: i, res
 148     integer :: shift
 149     res = ishft(i,shift)
 150   end function
 151   function ishft_4 (i, shift) result(res)
 152     integer(kind=4) :: i, res
 153     integer :: shift
 154     res = ishft(i,shift)
 155   end function
 156   function ishft_8 (i, shift) result(res)
 157     integer(kind=8) :: i, res
 158     integer :: shift
 159     res = ishft(i,shift)
 160   end function
 161
 162 end