1! Program to test intrinsic functions as actual arguments
2!
3! Please keep the content of this file in sync with gfortran.dg/specifics_1.f90
4subroutine test_c(fn, val, res)
5  complex fn
6  complex val, res
7
8  if (diff(fn(val),res)) STOP 1
9contains
10function diff(a,b)
11  complex a,b
12  logical diff
13  diff = (abs(a - b) .gt. 0.00001)
14end function
15end subroutine
16
17subroutine test_z(fn, val, res)
18  double complex fn
19  double complex val, res
20
21  if (diff(fn(val),res)) STOP 2
22contains
23function diff(a,b)
24  double complex a,b
25  logical diff
26  diff = (abs(a - b) .gt. 0.00001)
27end function
28end subroutine
29
30subroutine test_cabs(fn, val, res)
31  real fn, res
32  complex val
33
34  if (diff(fn(val),res)) STOP 3
35contains
36function diff(a,b)
37  real a,b
38  logical diff
39  diff = (abs(a - b) .gt. 0.00001)
40end function
41end subroutine
42
43subroutine test_cdabs(fn, val, res)
44  double precision fn, res
45  double complex val
46
47  if (diff(fn(val),res)) STOP 4
48contains
49function diff(a,b)
50  double precision a,b
51  logical diff
52  diff = (abs(a - b) .gt. 0.00001)
53end function
54end subroutine
55
56subroutine test_r(fn, val, res)
57  real fn
58  real val, res
59
60  if (diff(fn(val), res)) STOP 5
61contains
62function diff(a, b)
63  real a, b
64  logical diff
65  diff = (abs(a - b) .gt. 0.00001)
66end function
67end subroutine
68
69subroutine test_d(fn, val, res)
70  double precision fn
71  double precision val, res
72
73  if (diff(fn(val), res)) STOP 6
74contains
75function diff(a, b)
76  double precision a, b
77  logical diff
78  diff = (abs(a - b) .gt. 0.00001d0)
79end function
80end subroutine
81
82subroutine test_r2(fn, val1, val2, res)
83  real fn
84  real val1, val2, res
85
86  if (diff(fn(val1, val2), res)) STOP 7
87contains
88function diff(a, b)
89  real a, b
90  logical diff
91  diff = (abs(a - b) .gt. 0.00001)
92end function
93end subroutine
94
95subroutine test_d2(fn, val1, val2, res)
96  double precision fn
97  double precision val1, val2, res
98
99  if (diff(fn(val1, val2), res)) STOP 8
100contains
101function diff(a, b)
102  double precision a, b
103  logical diff
104  diff = (abs(a - b) .gt. 0.00001d0)
105end function
106end subroutine
107
108subroutine test_dprod(fn)
109  double precision fn
110  if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) STOP 9
111end subroutine
112
113subroutine test_nint(fn,val,res)
114  integer fn, res
115  real val
116  if (res .ne. fn(val)) STOP 10
117end subroutine
118
119subroutine test_idnint(fn,val,res)
120  integer fn, res
121  double precision val
122  if (res .ne. fn(val)) STOP 11
123end subroutine
124
125subroutine test_idim(fn,val1,val2,res)
126  integer fn, res, val1, val2
127  if (res .ne. fn(val1,val2)) STOP 12
128end subroutine
129
130subroutine test_iabs(fn,val,res)
131  integer fn, res, val
132  if (res .ne. fn(val)) STOP 13
133end subroutine
134
135subroutine test_len(fn,val,res)
136  integer fn, res
137  character(len=*) val
138  if (res .ne. fn(val)) STOP 14
139end subroutine
140
141subroutine test_index(fn,val1,val2,res)
142  integer fn, res
143  character(len=*) val1, val2
144  if (fn(val1,val2) .ne. res) STOP 15
145end subroutine
146
147program specifics
148  intrinsic abs
149  intrinsic aint
150  intrinsic anint
151  intrinsic acos
152  intrinsic acosh
153  intrinsic asin
154  intrinsic asinh
155  intrinsic atan
156  intrinsic atanh
157  intrinsic cos
158  intrinsic sin
159  intrinsic tan
160  intrinsic cosh
161  intrinsic sinh
162  intrinsic tanh
163  intrinsic alog
164  intrinsic alog10
165  intrinsic exp
166  intrinsic sign
167  intrinsic isign
168  intrinsic amod
169
170  intrinsic dabs
171  intrinsic dint
172  intrinsic dnint
173  intrinsic dacos
174  intrinsic dacosh
175  intrinsic dasin
176  intrinsic dasinh
177  intrinsic datan
178  intrinsic datanh
179  intrinsic dcos
180  intrinsic dsin
181  intrinsic dtan
182  intrinsic dcosh
183  intrinsic dsinh
184  intrinsic dtanh
185  intrinsic dlog
186  intrinsic dlog10
187  intrinsic dexp
188  intrinsic dsign
189  intrinsic dmod
190
191  intrinsic conjg
192  intrinsic ccos
193  intrinsic cexp
194  intrinsic clog
195  intrinsic csin
196  intrinsic csqrt
197
198  intrinsic dconjg
199  intrinsic cdcos
200  intrinsic cdexp
201  intrinsic cdlog
202  intrinsic cdsin
203  intrinsic cdsqrt
204  intrinsic zcos
205  intrinsic zexp
206  intrinsic zlog
207  intrinsic zsin
208  intrinsic zsqrt
209
210  intrinsic cabs
211  intrinsic cdabs
212  intrinsic zabs
213
214  intrinsic dprod
215
216  intrinsic nint
217  intrinsic idnint
218  intrinsic dim
219  intrinsic ddim
220  intrinsic idim
221  intrinsic iabs
222  intrinsic mod
223  intrinsic len
224  intrinsic index
225
226  intrinsic aimag
227  intrinsic dimag
228
229  call test_r (abs, -1.0, abs(-1.0))
230  call test_r (aint, 1.7, aint(1.7))
231  call test_r (anint, 1.7, anint(1.7))
232  call test_r (acos, 0.5, acos(0.5))
233  call test_r (acosh, 1.5, acosh(1.5))
234  call test_r (asin, 0.5, asin(0.5))
235  call test_r (asinh, 0.5, asinh(0.5))
236  call test_r (atan, 0.5, atan(0.5))
237  call test_r (atanh, 0.5, atanh(0.5))
238  call test_r (cos, 1.0, cos(1.0))
239  call test_r (sin, 1.0, sin(1.0))
240  call test_r (tan, 1.0, tan(1.0))
241  call test_r (cosh, 1.0, cosh(1.0))
242  call test_r (sinh, 1.0, sinh(1.0))
243  call test_r (tanh, 1.0, tanh(1.0))
244  call test_r (alog, 2.0, alog(2.0))
245  call test_r (alog10, 2.0, alog10(2.0))
246  call test_r (exp, 1.0, exp(1.0))
247  call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
248  call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
249
250  call test_d (dabs, -1d0, abs(-1d0))
251  call test_d (dint, 1.7d0, 1d0)
252  call test_d (dnint, 1.7d0, 2d0)
253  call test_d (dacos, 0.5d0, dacos(0.5d0))
254  call test_d (dacosh, 1.5d0, dacosh(1.5d0))
255  call test_d (dasin, 0.5d0, dasin(0.5d0))
256  call test_d (dasinh, 0.5d0, dasinh(0.5d0))
257  call test_d (datan, 0.5d0, datan(0.5d0))
258  call test_d (datanh, 0.5d0, datanh(0.5d0))
259  call test_d (dcos, 1d0, dcos(1d0))
260  call test_d (dsin, 1d0, dsin(1d0))
261  call test_d (dtan, 1d0, dtan(1d0))
262  call test_d (dcosh, 1d0, dcosh(1d0))
263  call test_d (dsinh, 1d0, dsinh(1d0))
264  call test_d (dtanh, 1d0, dtanh(1d0))
265  call test_d (dlog, 2d0, dlog(2d0))
266  call test_d (dlog10, 2d0, dlog10(2d0))
267  call test_d (dexp, 1d0, dexp(1d0))
268  call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
269  call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))
270
271  call test_dprod (dprod)
272
273  call test_c (conjg, (1.2,-4.), conjg((1.2,-4.)))
274  call test_c (ccos, (1.2,-4.), ccos((1.2,-4.)))
275  call test_c (cexp, (1.2,-4.), cexp((1.2,-4.)))
276  call test_c (clog, (1.2,-4.), clog((1.2,-4.)))
277  call test_c (csin, (1.2,-4.), csin((1.2,-4.)))
278  call test_c (csqrt, (1.2,-4.), csqrt((1.2,-4.)))
279
280  call test_z (dconjg, (1.2d0,-4.d0), dconjg((1.2d0,-4.d0)))
281  call test_z (cdcos, (1.2d0,-4.d0), cdcos((1.2d0,-4.d0)))
282  call test_z (zcos, (1.2d0,-4.d0), zcos((1.2d0,-4.d0)))
283  call test_z (cdexp, (1.2d0,-4.d0), cdexp((1.2d0,-4.d0)))
284  call test_z (zexp, (1.2d0,-4.d0), zexp((1.2d0,-4.d0)))
285  call test_z (cdlog, (1.2d0,-4.d0), cdlog((1.2d0,-4.d0)))
286  call test_z (zlog, (1.2d0,-4.d0), zlog((1.2d0,-4.d0)))
287  call test_z (cdsin, (1.2d0,-4.d0), cdsin((1.2d0,-4.d0)))
288  call test_z (zsin, (1.2d0,-4.d0), zsin((1.2d0,-4.d0)))
289  call test_z (cdsqrt, (1.2d0,-4.d0), cdsqrt((1.2d0,-4.d0)))
290  call test_z (zsqrt, (1.2d0,-4.d0), zsqrt((1.2d0,-4.d0)))
291
292  call test_cabs (cabs, (1.2,-4.), cabs((1.2,-4.)))
293  call test_cdabs (cdabs, (1.2d0,-4.d0), cdabs((1.2d0,-4.d0)))
294  call test_cdabs (zabs, (1.2d0,-4.d0), zabs((1.2d0,-4.d0)))
295  call test_cabs (aimag, (1.2,-4.), aimag((1.2,-4.)))
296  call test_cdabs (dimag, (1.2d0,-4.d0), dimag((1.2d0,-4.d0)))
297
298  call test_nint (nint, -1.2, nint(-1.2))
299  call test_idnint (idnint, -1.2d0, idnint(-1.2d0))
300  call test_idim (isign, -42, 17, isign(-42, 17))
301  call test_idim (idim, -42, 17, idim(-42,17))
302  call test_idim (idim, 42, 17, idim(42,17))
303  call test_r2 (dim, 1.2, -4., dim(1.2, -4.))
304  call test_d2 (ddim, 1.2d0, -4.d0, ddim(1.2d0, -4.d0))
305  call test_iabs (iabs, -7, iabs(-7))
306  call test_idim (mod, 5, 2, mod(5,2))
307  call test_len (len, "foobar", len("foobar"))
308  call test_index (index, "foobarfoobar", "bar", index("foobarfoobar","bar"))
309
310end program
311
312