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