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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
! Test the SHIFTA, SHIFTL and SHIFTR intrinsics.
!
! { dg-do run }
! { dg-options "-ffree-line-length-none" }
interface run_shifta
procedure shifta_1
procedure shifta_2
procedure shifta_4
procedure shifta_8
end interface
interface run_shiftl
procedure shiftl_1
procedure shiftl_2
procedure shiftl_4
procedure shiftl_8
end interface
interface run_shiftr
procedure shiftr_1
procedure shiftr_2
procedure shiftr_4
procedure shiftr_8
end interface
interface run_ishft
procedure ishft_1
procedure ishft_2
procedure ishft_4
procedure ishft_8
end interface
#define CHECK(I,SHIFT,RESA,RESL,RESR) \
if (shifta(I,SHIFT) /= RESA) call abort ; \
if (shiftr(I,SHIFT) /= RESR) call abort ; \
if (shiftl(I,SHIFT) /= RESL) call abort ; \
if (run_shifta(I,SHIFT) /= RESA) call abort ; \
if (run_shiftr(I,SHIFT) /= RESR) call abort ; \
if (run_shiftl(I,SHIFT) /= RESL) call abort ; \
if (ishft(I,SHIFT) /= RESL) call abort ; \
if (ishft(I,-SHIFT) /= RESR) call abort ; \
if (run_ishft(I,SHIFT) /= RESL) call abort ; \
if (run_ishft(I,-SHIFT) /= RESR) call abort
CHECK(0_1,0,0_1,0_1,0_1)
CHECK(11_1,0,11_1,11_1,11_1)
CHECK(-11_1,0,-11_1,-11_1,-11_1)
CHECK(0_1,1,0_1,0_1,0_1)
CHECK(11_1,1,5_1,22_1,5_1)
CHECK(11_1,2,2_1,44_1,2_1)
CHECK(-11_1,1,-6_1,-22_1,huge(0_1)-5_1)
CHECK(0_2,0,0_2,0_2,0_2)
CHECK(11_2,0,11_2,11_2,11_2)
CHECK(-11_2,0,-11_2,-11_2,-11_2)
CHECK(0_2,1,0_2,0_2,0_2)
CHECK(11_2,1,5_2,22_2,5_2)
CHECK(11_2,2,2_2,44_2,2_2)
CHECK(-11_2,1,-6_2,-22_2,huge(0_2)-5_2)
CHECK(0_4,0,0_4,0_4,0_4)
CHECK(11_4,0,11_4,11_4,11_4)
CHECK(-11_4,0,-11_4,-11_4,-11_4)
CHECK(0_4,1,0_4,0_4,0_4)
CHECK(11_4,1,5_4,22_4,5_4)
CHECK(11_4,2,2_4,44_4,2_4)
CHECK(-11_4,1,-6_4,-22_4,huge(0_4)-5_4)
CHECK(0_8,0,0_8,0_8,0_8)
CHECK(11_8,0,11_8,11_8,11_8)
CHECK(-11_8,0,-11_8,-11_8,-11_8)
CHECK(0_8,1,0_8,0_8,0_8)
CHECK(11_8,1,5_8,22_8,5_8)
CHECK(11_8,2,2_8,44_8,2_8)
CHECK(-11_8,1,-6_8,-22_8,huge(0_8)-5_8)
contains
function shifta_1 (i, shift) result(res)
integer(kind=1) :: i, res
integer :: shift
res = shifta(i,shift)
end function
function shiftl_1 (i, shift) result(res)
integer(kind=1) :: i, res
integer :: shift
res = shiftl(i,shift)
end function
function shiftr_1 (i, shift) result(res)
integer(kind=1) :: i, res
integer :: shift
res = shiftr(i,shift)
end function
function shifta_2 (i, shift) result(res)
integer(kind=2) :: i, res
integer :: shift
res = shifta(i,shift)
end function
function shiftl_2 (i, shift) result(res)
integer(kind=2) :: i, res
integer :: shift
res = shiftl(i,shift)
end function
function shiftr_2 (i, shift) result(res)
integer(kind=2) :: i, res
integer :: shift
res = shiftr(i,shift)
end function
function shifta_4 (i, shift) result(res)
integer(kind=4) :: i, res
integer :: shift
res = shifta(i,shift)
end function
function shiftl_4 (i, shift) result(res)
integer(kind=4) :: i, res
integer :: shift
res = shiftl(i,shift)
end function
function shiftr_4 (i, shift) result(res)
integer(kind=4) :: i, res
integer :: shift
res = shiftr(i,shift)
end function
function shifta_8 (i, shift) result(res)
integer(kind=8) :: i, res
integer :: shift
res = shifta(i,shift)
end function
function shiftl_8 (i, shift) result(res)
integer(kind=8) :: i, res
integer :: shift
res = shiftl(i,shift)
end function
function shiftr_8 (i, shift) result(res)
integer(kind=8) :: i, res
integer :: shift
res = shiftr(i,shift)
end function
function ishft_1 (i, shift) result(res)
integer(kind=1) :: i, res
integer :: shift
res = ishft(i,shift)
end function
function ishft_2 (i, shift) result(res)
integer(kind=2) :: i, res
integer :: shift
res = ishft(i,shift)
end function
function ishft_4 (i, shift) result(res)
integer(kind=4) :: i, res
integer :: shift
res = ishft(i,shift)
end function
function ishft_8 (i, shift) result(res)
integer(kind=8) :: i, res
integer :: shift
res = ishft(i,shift)
end function
end
|
