1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
! { 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
|
