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