gcc/testsuite/gfortran.dg/bit_comparison_2.F90

   1 ! Test the BGE, BGT, BLE and BLT intrinsics.
   2 !
   3 ! { dg-do run }
   4 ! { dg-options "-ffree-line-length-none" }
   5 ! { dg-require-effective-target fortran_integer_16 }
   6
   7 #define CHECK(I,J,RES) \
   8   if (bge(I,J) .neqv. RES) call abort ; \
   9   if (run_bge(I,J) .neqv. RES) call abort ; \
  10   if (bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
  11   if (run_bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
  12   if (ble(J,I) .neqv. RES) call abort ; \
  13   if (run_ble(J,I) .neqv. RES) call abort ; \
  14   if (blt(J,I) .neqv. (RES .and. (I/=J))) call abort ; \
  15   if (run_blt(J,I) .neqv. (RES .and. (I/=J))) call abort
  16
  17 #define T .true.
  18 #define F .false.
  19
  20   CHECK(0_16, 0_16, T)
  21   CHECK(1_16, 0_16, T)
  22   CHECK(0_16, 107_16, F)
  23   CHECK(5_16, huge(0_16) / 2_16, F)
  24   CHECK(5_16, huge(0_16), F)
  25   CHECK(-1_16, 0_16, T)
  26   CHECK(0_16, -19_16, F)
  27   CHECK(huge(0_16), -19_16, F)
  28
  29 contains
  30
  31   pure logical function run_bge (i, j) result(res)
  32     integer(kind=16), intent(in) :: i, j
  33     res = bge(i,j)
  34   end function
  35   pure logical function run_bgt (i, j) result(res)
  36     integer(kind=16), intent(in) :: i, j
  37     res = bgt(i,j)
  38   end function
  39   pure logical function run_ble (i, j) result(res)
  40     integer(kind=16), intent(in) :: i, j
  41     res = ble(i,j)
  42   end function
  43   pure logical function run_blt (i, j) result(res)
  44     integer(kind=16), intent(in) :: i, j
  45     res = blt(i,j)
  46   end function
  47
  48 end