Fix warning with -Wsign-compare -Wsystem-headers
[official-gcc.git] / gcc / testsuite / gfortran.fortran-torture / execute / specifics.f90
blobe6aa5e78df320ff92eb93ec28aa7357754a2181d
1 ! Program to test intrinsic functions as actual arguments
3 ! Please keep the content of this file in sync with gfortran.dg/specifics_1.f90
4 subroutine test_c(fn, val, res)
5 complex fn
6 complex val, res
8 if (diff(fn(val),res)) STOP 1
9 contains
10 function diff(a,b)
11 complex a,b
12 logical diff
13 diff = (abs(a - b) .gt. 0.00001)
14 end function
15 end subroutine
17 subroutine test_z(fn, val, res)
18 double complex fn
19 double complex val, res
21 if (diff(fn(val),res)) STOP 2
22 contains
23 function diff(a,b)
24 double complex a,b
25 logical diff
26 diff = (abs(a - b) .gt. 0.00001)
27 end function
28 end subroutine
30 subroutine test_cabs(fn, val, res)
31 real fn, res
32 complex val
34 if (diff(fn(val),res)) STOP 3
35 contains
36 function diff(a,b)
37 real a,b
38 logical diff
39 diff = (abs(a - b) .gt. 0.00001)
40 end function
41 end subroutine
43 subroutine test_cdabs(fn, val, res)
44 double precision fn, res
45 double complex val
47 if (diff(fn(val),res)) STOP 4
48 contains
49 function diff(a,b)
50 double precision a,b
51 logical diff
52 diff = (abs(a - b) .gt. 0.00001)
53 end function
54 end subroutine
56 subroutine test_r(fn, val, res)
57 real fn
58 real val, res
60 if (diff(fn(val), res)) STOP 5
61 contains
62 function diff(a, b)
63 real a, b
64 logical diff
65 diff = (abs(a - b) .gt. 0.00001)
66 end function
67 end subroutine
69 subroutine test_d(fn, val, res)
70 double precision fn
71 double precision val, res
73 if (diff(fn(val), res)) STOP 6
74 contains
75 function diff(a, b)
76 double precision a, b
77 logical diff
78 diff = (abs(a - b) .gt. 0.00001d0)
79 end function
80 end subroutine
82 subroutine test_r2(fn, val1, val2, res)
83 real fn
84 real val1, val2, res
86 if (diff(fn(val1, val2), res)) STOP 7
87 contains
88 function diff(a, b)
89 real a, b
90 logical diff
91 diff = (abs(a - b) .gt. 0.00001)
92 end function
93 end subroutine
95 subroutine test_d2(fn, val1, val2, res)
96 double precision fn
97 double precision val1, val2, res
99 if (diff(fn(val1, val2), res)) STOP 8
100 contains
101 function diff(a, b)
102 double precision a, b
103 logical diff
104 diff = (abs(a - b) .gt. 0.00001d0)
105 end function
106 end subroutine
108 subroutine test_dprod(fn)
109 double precision fn
110 if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) STOP 9
111 end subroutine
113 subroutine test_nint(fn,val,res)
114 integer fn, res
115 real val
116 if (res .ne. fn(val)) STOP 10
117 end subroutine
119 subroutine test_idnint(fn,val,res)
120 integer fn, res
121 double precision val
122 if (res .ne. fn(val)) STOP 11
123 end subroutine
125 subroutine test_idim(fn,val1,val2,res)
126 integer fn, res, val1, val2
127 if (res .ne. fn(val1,val2)) STOP 12
128 end subroutine
130 subroutine test_iabs(fn,val,res)
131 integer fn, res, val
132 if (res .ne. fn(val)) STOP 13
133 end subroutine
135 subroutine test_len(fn,val,res)
136 integer fn, res
137 character(len=*) val
138 if (res .ne. fn(val)) STOP 14
139 end subroutine
141 subroutine test_index(fn,val1,val2,res)
142 integer fn, res
143 character(len=*) val1, val2
144 if (fn(val1,val2) .ne. res) STOP 15
145 end subroutine
147 program 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
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
191 intrinsic conjg
192 intrinsic ccos
193 intrinsic cexp
194 intrinsic clog
195 intrinsic csin
196 intrinsic csqrt
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
210 intrinsic cabs
211 intrinsic cdabs
212 intrinsic zabs
214 intrinsic dprod
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
226 intrinsic aimag
227 intrinsic dimag
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))
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))
271 call test_dprod (dprod)
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.)))
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)))
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)))
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"))
310 end program