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