| ! { dg-do run } |
| ! |
| ! Test shift intrinsics when the SHIFT argument equals BIT_SIZE(arg1). |
| |
| program test |
| implicit none |
| ! Test compile-time simplifications |
| if (ishft (-1, 32) /= 0) stop 1 ! 0 -> simplify_shift OK |
| if (ishft (-1,-32) /= 0) stop 2 ! 0 -> simplify_shift OK |
| if (shiftl (-1, 32) /= 0) stop 3 ! 0 -> simplify_shift OK |
| if (shiftr (-1, 32) /= 0) stop 4 ! 0 -> simplify_shift OK |
| if (shifta (-1, 32) /= -1) stop 5 ! -1 -> simplify_shift OK |
| if (rshift (-1, 32) /= -1) stop 6 ! -1 -> simplify_shift OK |
| if (lshift (-1, 32) /= 0) stop 7 ! 0 -> simplify_shift OK |
| ! Test run-time |
| call foo (-1) |
| contains |
| subroutine foo (n) |
| integer(4) :: i, j, k, n |
| integer, parameter :: bb = bit_size (n) |
| ! Test code generated by gfc_conv_intrinsic_ishft |
| i = ishft (n, bb) ! Logical (left) shift (Fortran 2008) |
| j = ishft (n,-bb) ! Logical (right) shift (Fortran 2008) |
| if (i /= 0) stop 11 |
| if (j /= 0) stop 12 |
| ! Test code generated by gfc_conv_intrinsic_shift: |
| i = shiftl (n, bb) ! Logical left shift (Fortran 2008) |
| j = shiftr (n, bb) ! Logical right shift (Fortran 2008) |
| k = shifta (n, bb) ! Arithmetic right shift (Fortran 2008) |
| if (i /= 0) stop 13 |
| if (j /= 0) stop 14 |
| if (k /= -1) stop 15 |
| i = lshift (n, bb) ! Logical left shift (GNU extension) |
| j = rshift (n, bb) ! Arithmetic right shift (GNU extension) |
| if (i /= 0) stop 16 |
| if (j /= -1) stop 17 |
| do i = bb-1,bb |
| if (shifta (n, i) /= -1) stop 18 |
| if (rshift (n, i) /= -1) stop 19 |
| end do |
| end subroutine foo |
| end program test |
