gcc/testsuite/gfortran.dg/dshift_1.F90

   1 ! Test the DSHIFTL and DSHIFTR intrinsics.
   2 !
   3 ! { dg-do run }
   4 ! { dg-options "-ffree-line-length-none" }
   5
   6   implicit none
   7
   8   interface run_dshiftl
   9     procedure dshiftl_1
  10     procedure dshiftl_2
  11     procedure dshiftl_4
  12     procedure dshiftl_8
  13   end interface
  14   interface run_dshiftr
  15     procedure dshiftr_1
  16     procedure dshiftr_2
  17     procedure dshiftr_4
  18     procedure dshiftr_8
  19   end interface
  20
  21 #define RESL(I,J,SHIFT) \
  22   IOR(SHIFTL(I,SHIFT),SHIFTR(J,BIT_SIZE(J)-SHIFT))
  23 #define RESR(I,J,SHIFT) \
  24   IOR(SHIFTL(I,BIT_SIZE(I)-SHIFT),SHIFTR(J,SHIFT))
  25
  26 #define CHECK(I,J,SHIFT) \
  27   if (dshiftl(I,J,SHIFT) /= RESL(I,J,SHIFT)) call abort ; \
  28   if (dshiftr(I,J,SHIFT) /= RESR(I,J,SHIFT)) call abort ; \
  29   if (run_dshiftl(I,J,SHIFT) /= RESL(I,J,SHIFT)) call abort ; \
  30   if (run_dshiftr(I,J,SHIFT) /= RESR(I,J,SHIFT)) call abort
  31
  32   CHECK(0_1,0_1,0)
  33   CHECK(0_1,0_1,1)
  34   CHECK(0_1,0_1,7)
  35   CHECK(0_1,0_1,8)
  36   CHECK(28_1,79_1,0)
  37   CHECK(28_1,79_1,1)
  38   CHECK(28_1,79_1,5)
  39   CHECK(28_1,79_1,7)
  40   CHECK(28_1,79_1,8)
  41   CHECK(-28_1,79_1,0)
  42   CHECK(-28_1,79_1,1)
  43   CHECK(-28_1,79_1,5)
  44   CHECK(-28_1,79_1,7)
  45   CHECK(-28_1,79_1,8)
  46   CHECK(28_1,-79_1,0)
  47   CHECK(28_1,-79_1,1)
  48   CHECK(28_1,-79_1,5)
  49   CHECK(28_1,-79_1,7)
  50   CHECK(28_1,-79_1,8)
  51   CHECK(-28_1,-79_1,0)
  52   CHECK(-28_1,-79_1,1)
  53   CHECK(-28_1,-79_1,5)
  54   CHECK(-28_1,-79_1,7)
  55   CHECK(-28_1,-79_1,8)
  56
  57   CHECK(0_2,0_2,0)
  58   CHECK(0_2,0_2,1)
  59   CHECK(0_2,0_2,7)
  60   CHECK(0_2,0_2,8)
  61   CHECK(28_2,79_2,0)
  62   CHECK(28_2,79_2,1)
  63   CHECK(28_2,79_2,5)
  64   CHECK(28_2,79_2,7)
  65   CHECK(28_2,79_2,8)
  66   CHECK(-28_2,79_2,0)
  67   CHECK(-28_2,79_2,1)
  68   CHECK(-28_2,79_2,5)
  69   CHECK(-28_2,79_2,7)
  70   CHECK(-28_2,79_2,8)
  71   CHECK(28_2,-79_2,0)
  72   CHECK(28_2,-79_2,1)
  73   CHECK(28_2,-79_2,5)
  74   CHECK(28_2,-79_2,7)
  75   CHECK(28_2,-79_2,8)
  76   CHECK(-28_2,-79_2,0)
  77   CHECK(-28_2,-79_2,1)
  78   CHECK(-28_2,-79_2,5)
  79   CHECK(-28_2,-79_2,7)
  80   CHECK(-28_2,-79_2,8)
  81
  82   CHECK(0_4,0_4,0)
  83   CHECK(0_4,0_4,1)
  84   CHECK(0_4,0_4,7)
  85   CHECK(0_4,0_4,8)
  86   CHECK(28_4,79_4,0)
  87   CHECK(28_4,79_4,1)
  88   CHECK(28_4,79_4,5)
  89   CHECK(28_4,79_4,7)
  90   CHECK(28_4,79_4,8)
  91   CHECK(-28_4,79_4,0)
  92   CHECK(-28_4,79_4,1)
  93   CHECK(-28_4,79_4,5)
  94   CHECK(-28_4,79_4,7)
  95   CHECK(-28_4,79_4,8)
  96   CHECK(28_4,-79_4,0)
  97   CHECK(28_4,-79_4,1)
  98   CHECK(28_4,-79_4,5)
  99   CHECK(28_4,-79_4,7)
 100   CHECK(28_4,-79_4,8)
 101   CHECK(-28_4,-79_4,0)
 102   CHECK(-28_4,-79_4,1)
 103   CHECK(-28_4,-79_4,5)
 104   CHECK(-28_4,-79_4,7)
 105   CHECK(-28_4,-79_4,8)
 106
 107   CHECK(0_8,0_8,0)
 108   CHECK(0_8,0_8,1)
 109   CHECK(0_8,0_8,7)
 110   CHECK(0_8,0_8,8)
 111   CHECK(28_8,79_8,0)
 112   CHECK(28_8,79_8,1)
 113   CHECK(28_8,79_8,5)
 114   CHECK(28_8,79_8,7)
 115   CHECK(28_8,79_8,8)
 116   CHECK(-28_8,79_8,0)
 117   CHECK(-28_8,79_8,1)
 118   CHECK(-28_8,79_8,5)
 119   CHECK(-28_8,79_8,7)
 120   CHECK(-28_8,79_8,8)
 121   CHECK(28_8,-79_8,0)
 122   CHECK(28_8,-79_8,1)
 123   CHECK(28_8,-79_8,5)
 124   CHECK(28_8,-79_8,7)
 125   CHECK(28_8,-79_8,8)
 126   CHECK(-28_8,-79_8,0)
 127   CHECK(-28_8,-79_8,1)
 128   CHECK(-28_8,-79_8,5)
 129   CHECK(-28_8,-79_8,7)
 130   CHECK(-28_8,-79_8,8)
 131
 132
 133 contains
 134
 135   function dshiftl_1 (i, j, shift) result(res)
 136     integer(kind=1) :: i, j, res
 137     integer :: shift
 138     res = dshiftl(i,j,shift)
 139   end function
 140   function dshiftl_2 (i, j, shift) result(res)
 141     integer(kind=2) :: i, j, res
 142     integer :: shift
 143     res = dshiftl(i,j,shift)
 144   end function
 145   function dshiftl_4 (i, j, shift) result(res)
 146     integer(kind=4) :: i, j, res
 147     integer :: shift
 148     res = dshiftl(i,j,shift)
 149   end function
 150   function dshiftl_8 (i, j, shift) result(res)
 151     integer(kind=8) :: i, j, res
 152     integer :: shift
 153     res = dshiftl(i,j,shift)
 154   end function
 155
 156   function dshiftr_1 (i, j, shift) result(res)
 157     integer(kind=1) :: i, j, res
 158     integer :: shift
 159     res = dshiftr(i,j,shift)
 160   end function
 161   function dshiftr_2 (i, j, shift) result(res)
 162     integer(kind=2) :: i, j, res
 163     integer :: shift
 164     res = dshiftr(i,j,shift)
 165   end function
 166   function dshiftr_4 (i, j, shift) result(res)
 167     integer(kind=4) :: i, j, res
 168     integer :: shift
 169     res = dshiftr(i,j,shift)
 170   end function
 171   function dshiftr_8 (i, j, shift) result(res)
 172     integer(kind=8) :: i, j, res
 173     integer :: shift
 174     res = dshiftr(i,j,shift)
 175   end function
 176
 177 end