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
|
! { dg-do run }
! { dg-options "-funsigned" }
! Test dshiftl, dshiftr, ibclr, ibset and ibits intrinsics.
program main
unsigned :: u, v, w
integer :: i, j, k
u = 1u; v = 4u
i = 1; j = 4
if (int(dshiftl(u,v,12)) /= dshiftl(i,j,12)) error stop 1
if (int(dshiftl(1u,4u,12)) /= dshiftl(1,4,12)) error stop 2
if (int(dshiftr(u,v,12)) /= dshiftr(i,j,12)) error stop 3
if (int(dshiftr(1u,4u,12)) /= dshiftr(1,4,12)) error stop 4
k = 14
if (int(dshiftl(u,v,k)) /= dshiftl(i,j,k)) error stop 5
if (int(dshiftl(1u,4u,k)) /= dshiftl(1,4,k)) error stop 6
if (int(dshiftr(u,v,k)) /= dshiftr(i,j,k)) error stop 7
if (int(dshiftr(1u,4u,k)) /= dshiftr(1,4,k)) error stop 8
u = 255u
i = 255
do k=0,8
if (ibclr(i,k) /= int(ibclr(u,k))) error stop 9
if (ibset(i,k+4) /= int(ibset(u,k+4))) error stop 10
end do
if (ibclr(255,5) /= int(ibclr(255u,5))) error stop 11
if (ibset(255,10) /= int(ibset(255u,10))) error stop 12
if (uint(ibits(6,6,2)) /= ibits(6u,6,2)) error stop 13
end program main
|
