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