gcc/testsuite/gfortran.dg/bit_comparison_1.F90

   1 ! Test the BGE, BGT, BLE and BLT intrinsics.
   2 !
   3 ! { dg-do run }
   4 ! { dg-options "-ffree-line-length-none" }
   5
   6   interface run_bge
   7     procedure run_bge1
   8     procedure run_bge2
   9     procedure run_bge4
  10     procedure run_bge8
  11   end interface
  12
  13   interface run_bgt
  14     procedure run_bgt1
  15     procedure run_bgt2
  16     procedure run_bgt4
  17     procedure run_bgt8
  18   end interface
  19
  20   interface run_ble
  21     procedure run_ble1
  22     procedure run_ble2
  23     procedure run_ble4
  24     procedure run_ble8
  25   end interface
  26
  27   interface run_blt
  28     procedure run_blt1
  29     procedure run_blt2
  30     procedure run_blt4
  31     procedure run_blt8
  32   end interface
  33
  34 #define CHECK(I,J,RES) \
  35   if (bge(I,J) .neqv. RES) STOP 1; \
  36   if (run_bge(I,J) .neqv. RES) STOP 2; \
  37   if (bgt(I,J) .neqv. (RES .and. (I/=J))) STOP 3; \
  38   if (run_bgt(I,J) .neqv. (RES .and. (I/=J))) STOP 4; \
  39   if (ble(J,I) .neqv. RES) STOP 5; \
  40   if (run_ble(J,I) .neqv. RES) STOP 6; \
  41   if (blt(J,I) .neqv. (RES .and. (I/=J))) STOP 7; \
  42   if (run_blt(J,I) .neqv. (RES .and. (I/=J))) STOP 8
  43
  44 #define T .true.
  45 #define F .false.
  46
  47   CHECK(0_1, 0_1, T)
  48   CHECK(1_1, 0_1, T)
  49   CHECK(0_1, 107_1, F)
  50   CHECK(5_1, huge(0_1) / 2_1, F)
  51   CHECK(5_1, huge(0_1), F)
  52   CHECK(-1_1, 0_1, T)
  53   CHECK(0_1, -19_1, F)
  54   CHECK(huge(0_1), -19_1, F)
  55
  56   CHECK(0_2, 0_2, T)
  57   CHECK(1_2, 0_2, T)
  58   CHECK(0_2, 107_2, F)
  59   CHECK(5_2, huge(0_2) / 2_2, F)
  60   CHECK(5_2, huge(0_2), F)
  61   CHECK(-1_2, 0_2, T)
  62   CHECK(0_2, -19_2, F)
  63   CHECK(huge(0_2), -19_2, F)
  64
  65   CHECK(0_4, 0_4, T)
  66   CHECK(1_4, 0_4, T)
  67   CHECK(0_4, 107_4, F)
  68   CHECK(5_4, huge(0_4) / 2_4, F)
  69   CHECK(5_4, huge(0_4), F)
  70   CHECK(-1_4, 0_4, T)
  71   CHECK(0_4, -19_4, F)
  72   CHECK(huge(0_4), -19_4, F)
  73
  74   CHECK(0_8, 0_8, T)
  75   CHECK(1_8, 0_8, T)
  76   CHECK(0_8, 107_8, F)
  77   CHECK(5_8, huge(0_8) / 2_8, F)
  78   CHECK(5_8, huge(0_8), F)
  79   CHECK(-1_8, 0_8, T)
  80   CHECK(0_8, -19_8, F)
  81   CHECK(huge(0_8), -19_8, F)
  82
  83 contains
  84
  85   pure logical function run_bge1 (i, j) result(res)
  86     integer(kind=1), intent(in) :: i, j
  87     res = bge(i,j)
  88   end function
  89   pure logical function run_bgt1 (i, j) result(res)
  90     integer(kind=1), intent(in) :: i, j
  91     res = bgt(i,j)
  92   end function
  93   pure logical function run_ble1 (i, j) result(res)
  94     integer(kind=1), intent(in) :: i, j
  95     res = ble(i,j)
  96   end function
  97   pure logical function run_blt1 (i, j) result(res)
  98     integer(kind=1), intent(in) :: i, j
  99     res = blt(i,j)
 100   end function
 101
 102   pure logical function run_bge2 (i, j) result(res)
 103     integer(kind=2), intent(in) :: i, j
 104     res = bge(i,j)
 105   end function
 106   pure logical function run_bgt2 (i, j) result(res)
 107     integer(kind=2), intent(in) :: i, j
 108     res = bgt(i,j)
 109   end function
 110   pure logical function run_ble2 (i, j) result(res)
 111     integer(kind=2), intent(in) :: i, j
 112     res = ble(i,j)
 113   end function
 114   pure logical function run_blt2 (i, j) result(res)
 115     integer(kind=2), intent(in) :: i, j
 116     res = blt(i,j)
 117   end function
 118
 119   pure logical function run_bge4 (i, j) result(res)
 120     integer(kind=4), intent(in) :: i, j
 121     res = bge(i,j)
 122   end function
 123   pure logical function run_bgt4 (i, j) result(res)
 124     integer(kind=4), intent(in) :: i, j
 125     res = bgt(i,j)
 126   end function
 127   pure logical function run_ble4 (i, j) result(res)
 128     integer(kind=4), intent(in) :: i, j
 129     res = ble(i,j)
 130   end function
 131   pure logical function run_blt4 (i, j) result(res)
 132     integer(kind=4), intent(in) :: i, j
 133     res = blt(i,j)
 134   end function
 135
 136   pure logical function run_bge8 (i, j) result(res)
 137     integer(kind=8), intent(in) :: i, j
 138     res = bge(i,j)
 139   end function
 140   pure logical function run_bgt8 (i, j) result(res)
 141     integer(kind=8), intent(in) :: i, j
 142     res = bgt(i,j)
 143   end function
 144   pure logical function run_ble8 (i, j) result(res)
 145     integer(kind=8), intent(in) :: i, j
 146     res = ble(i,j)
 147   end function
 148   pure logical function run_blt8 (i, j) result(res)
 149     integer(kind=8), intent(in) :: i, j
 150     res = blt(i,j)
 151   end function
 152
 153 end