gcc/testsuite/gfortran.dg/shiftalr_3.f90

   1 ! { dg-do run }
   2 !
   3 ! Test shift intrinsics when the SHIFT argument equals BIT_SIZE(arg1).
   4
   5 program test
   6   implicit none
   7   ! Test compile-time simplifications
   8   if (ishft  (-1, 32) /=  0) stop 1 !  0 -> simplify_shift OK
   9   if (ishft  (-1,-32) /=  0) stop 2 !  0 -> simplify_shift OK
  10   if (shiftl (-1, 32) /=  0) stop 3 !  0 -> simplify_shift OK
  11   if (shiftr (-1, 32) /=  0) stop 4 !  0 -> simplify_shift OK
  12   if (shifta (-1, 32) /= -1) stop 5 ! -1 -> simplify_shift OK
  13   if (rshift (-1, 32) /= -1) stop 6 ! -1 -> simplify_shift OK
  14   if (lshift (-1, 32) /=  0) stop 7 !  0 -> simplify_shift OK
  15   ! Test run-time
  16   call foo (-1)
  17 contains
  18   subroutine foo (n)
  19     integer(4) :: i, j, k, n
  20     integer, parameter :: bb = bit_size (n)
  21     ! Test code generated by gfc_conv_intrinsic_ishft
  22     i = ishft  (n, bb) ! Logical (left)  shift (Fortran 2008)
  23     j = ishft  (n,-bb) ! Logical (right) shift (Fortran 2008)
  24     if (i /= 0) stop 11
  25     if (j /= 0) stop 12
  26     ! Test code generated by gfc_conv_intrinsic_shift:
  27     i = shiftl (n, bb) ! Logical    left  shift (Fortran 2008)
  28     j = shiftr (n, bb) ! Logical    right shift (Fortran 2008)
  29     k = shifta (n, bb) ! Arithmetic right shift (Fortran 2008)
  30     if (i /=  0) stop 13
  31     if (j /=  0) stop 14
  32     if (k /= -1) stop 15
  33     i = lshift (n, bb) ! Logical    left  shift (GNU extension)
  34     j = rshift (n, bb) ! Arithmetic right shift (GNU extension)
  35     if (i /=  0) stop 16
  36     if (j /= -1) stop 17
  37     do i = bb-1,bb
  38        if (shifta (n, i) /= -1) stop 18
  39        if (rshift (n, i) /= -1) stop 19
  40     end do
  41   end subroutine foo
  42 end program test