gcc/testsuite/gfortran.dg/ibits_2.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-fcheck=bits" }
   3 ! PR fortran/108937 - Intrinsic IBITS(I,POS,LEN) fails when LEN equals
   4 !                     to BIT_SIZE(I)
   5 ! Contributed by saitofuyuki@jamstec.go.jp
   6
   7 program test_bits
   8   implicit none
   9   integer, parameter :: KT = kind (1)
  10   integer, parameter :: lbits = bit_size (0_KT)
  11   integer(kind=KT) :: x, y0, y1
  12   integer(kind=KT) :: p, l
  13
  14   x = -1
  15   p = 0
  16   do l = 0, lbits
  17      y0 = ibits  (x, p, l)
  18      y1 = ibits_1(x, p, l)
  19      if (y0 /= y1) then
  20         print *, l, y0, y1
  21         stop 1+l
  22      end if
  23   end do
  24 contains
  25   elemental integer(kind=KT) function ibits_1(I, POS, LEN) result(n)
  26     !! IBITS(I, POS, LEN) = (I >> POS) & ~((~0) << LEN)
  27     implicit none
  28     integer(kind=KT),intent(in) :: I
  29     integer,         intent(in) :: POS, LEN
  30     n = IAND (ISHFT(I, - POS), NOT(ISHFT(-1_KT, LEN)))
  31   end function ibits_1
  32 end program test_bits