gcc/testsuite/gfortran.dg/check_bits_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcheck=bits -fdump-tree-original" }
   3 ! { dg-shouldfail "Fortran runtime error: SIZE argument (0) out of range 1:32 in intrinsic ISHFTC" }
   4 ! { dg-output "At line 44 .*" }
   5 !
   6 ! Verify that the runtime checks for the bit manipulation intrinsic functions
   7 ! do not generate false-positives
   8 program check
   9   implicit none
  10   integer :: i, k, pos, len, shift, size, nb
  11   nb = bit_size (i)
  12   i = 0
  13   do pos = 0, nb-1
  14      k = ibset (i, pos)
  15      i = ibclr (k, pos)
  16      if (btest (i, pos)) stop 1
  17   end do
  18   do pos = 0, nb
  19      do len = 0, nb-pos
  20         i = ibits (i, pos, len)
  21      end do
  22   end do
  23   do shift = 0, nb
  24      k = ishft (i,  shift)
  25      i = ishft (k, -shift)
  26   end do
  27   do shift = 0, nb
  28      k = shiftl (i, shift) ! Fortran 2008
  29      i = shiftr (k, shift)
  30      i = shifta (i, shift)
  31      k = lshift (i, shift) ! GNU extensions
  32      i = rshift (k, shift)
  33   end do
  34   do shift = 0, nb
  35      k = ishftc (i,  shift)
  36      i = ishftc (k, -shift)
  37      do size = max (1,shift), nb
  38         k = ishftc (i,  shift, size)
  39         i = ishftc (k, -shift, size)
  40      end do
  41   end do
  42   size = 0
  43   ! The following line should fail with a runtime error:
  44   k = ishftc (i, 0, size)
  45   ! Should never get here with -fcheck=bits
  46   stop 2
  47 end program check
  48
  49 ! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 21 "original" } }