! Program to test intrinsic functions as actual arguments
!
! Copied from gfortran.fortran-torture/execute/specifics.f90
! Please keep them in sync
!
! It is run here with -ff2c option
!
! { dg-do run }
! { dg-options "-ff2c" }
! Program to test intrinsic functions as actual arguments
subroutine test_c(fn, val, res)
complex fn
complex val, res
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
complex a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_z(fn, val, res)
double complex fn
double complex val, res
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
double complex a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_cabs(fn, val, res)
real fn, res
complex val
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
real a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_cdabs(fn, val, res)
double precision fn, res
double complex val
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
double precision a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_r(fn, val, res)
real fn
real val, res
if (diff(fn(val), res)) call abort
contains
function diff(a, b)
real a, b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_d(fn, val, res)
double precision fn
double precision val, res
if (diff(fn(val), res)) call abort
contains
function diff(a, b)
double precision a, b
logical diff
diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine
subroutine test_r2(fn, val1, val2, res)
real fn
real val1, val2, res
if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
real a, b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_d2(fn, val1, val2, res)
double precision fn
double precision val1, val2, res
if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
double precision a, b
logical diff
diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine
subroutine test_dprod(fn)
double precision fn
if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort
end subroutine
subroutine test_nint(fn,val,res)
integer fn, res
real val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_idnint(fn,val,res)
integer fn, res
double precision val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_idim(fn,val1,val2,res)
integer fn, res, val1, val2
if (res .ne. fn(val1,val2)) call abort
end subroutine
subroutine test_iabs(fn,val,res)
integer fn, res, val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_len(fn,val,res)
integer fn, res
character(len=*) val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_index(fn,val1,val2,res)
integer fn, res
character(len=*) val1, val2
if (fn(val1,val2) .ne. res) call abort
end subroutine
program specifics
intrinsic abs
intrinsic aint
intrinsic anint
intrinsic acos
intrinsic acosh
intrinsic asin
intrinsic asinh
intrinsic atan
intrinsic atanh
intrinsic cos
intrinsic sin
intrinsic tan
intrinsic cosh
intrinsic sinh
intrinsic tanh
intrinsic alog
intrinsic alog10
intrinsic exp
intrinsic sign
intrinsic isign
intrinsic amod
intrinsic dabs
intrinsic dint
intrinsic dnint
intrinsic dacos
intrinsic dacosh
intrinsic dasin
intrinsic dasinh
intrinsic datan
intrinsic datanh
intrinsic dcos
intrinsic dsin
intrinsic dtan
intrinsic dcosh
intrinsic dsinh
intrinsic dtanh
intrinsic dlog
intrinsic dlog10
intrinsic dexp
intrinsic dsign
intrinsic dmod
intrinsic conjg
intrinsic ccos
intrinsic cexp
intrinsic clog
intrinsic csin
intrinsic csqrt
intrinsic dconjg
intrinsic cdcos
intrinsic cdexp
intrinsic cdlog
intrinsic cdsin
intrinsic cdsqrt
intrinsic zcos
intrinsic zexp
intrinsic zlog
intrinsic zsin
intrinsic zsqrt
intrinsic cabs
intrinsic cdabs
intrinsic zabs
intrinsic dprod
intrinsic nint
intrinsic idnint
intrinsic dim
intrinsic ddim
intrinsic idim
intrinsic iabs
intrinsic mod
intrinsic len
intrinsic index
intrinsic aimag
intrinsic dimag
call test_r (abs, -1.0, abs(-1.0))
call test_r (aint, 1.7, aint(1.7))
call test_r (anint, 1.7, anint(1.7))
call test_r (acos, 0.5, acos(0.5))
call test_r (acosh, 1.5, acosh(1.5))
call test_r (asin, 0.5, asin(0.5))
call test_r (asinh, 0.5, asinh(0.5))
call test_r (atan, 0.5, atan(0.5))
call test_r (atanh, 0.5, atanh(0.5))
call test_r (cos, 1.0, cos(1.0))
call test_r (sin, 1.0, sin(1.0))
call test_r (tan, 1.0, tan(1.0))
call test_r (cosh, 1.0, cosh(1.0))
call test_r (sinh, 1.0, sinh(1.0))
call test_r (tanh, 1.0, tanh(1.0))
call test_r (alog, 2.0, alog(2.0))
call test_r (alog10, 2.0, alog10(2.0))
call test_r (exp, 1.0, exp(1.0))
call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
call test_d (dabs, -1d0, abs(-1d0))
call test_d (dint, 1.7d0, 1d0)
call test_d (dnint, 1.7d0, 2d0)
call test_d (dacos, 0.5d0, dacos(0.5d0))
call test_d (dacosh, 1.5d0, dacosh(1.5d0))
call test_d (dasin, 0.5d0, dasin(0.5d0))
call test_d (dasinh, 0.5d0, dasinh(0.5d0))
call test_d (datan, 0.5d0, datan(0.5d0))
call test_d (datanh, 0.5d0, datanh(0.5d0))
call test_d (dcos, 1d0, dcos(1d0))
call test_d (dsin, 1d0, dsin(1d0))
call test_d (dtan, 1d0, dtan(1d0))
call test_d (dcosh, 1d0, dcosh(1d0))
call test_d (dsinh, 1d0, dsinh(1d0))
call test_d (dtanh, 1d0, dtanh(1d0))
call test_d (dlog, 2d0, dlog(2d0))
call test_d (dlog10, 2d0, dlog10(2d0))
call test_d (dexp, 1d0, dexp(1d0))
call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))
call test_dprod (dprod)
call test_c (conjg, (1.2,-4.), conjg((1.2,-4.)))
call test_c (ccos, (1.2,-4.), ccos((1.2,-4.)))
call test_c (cexp, (1.2,-4.), cexp((1.2,-4.)))
call test_c (clog, (1.2,-4.), clog((1.2,-4.)))
call test_c (csin, (1.2,-4.), csin((1.2,-4.)))
call test_c (csqrt, (1.2,-4.), csqrt((1.2,-4.)))
call test_z (dconjg, (1.2d0,-4.d0), dconjg((1.2d0,-4.d0)))
call test_z (cdcos, (1.2d0,-4.d0), cdcos((1.2d0,-4.d0)))
call test_z (zcos, (1.2d0,-4.d0), zcos((1.2d0,-4.d0)))
call test_z (cdexp, (1.2d0,-4.d0), cdexp((1.2d0,-4.d0)))
call test_z (zexp, (1.2d0,-4.d0), zexp((1.2d0,-4.d0)))
call test_z (cdlog, (1.2d0,-4.d0), cdlog((1.2d0,-4.d0)))
call test_z (zlog, (1.2d0,-4.d0), zlog((1.2d0,-4.d0)))
call test_z (cdsin, (1.2d0,-4.d0), cdsin((1.2d0,-4.d0)))
call test_z (zsin, (1.2d0,-4.d0), zsin((1.2d0,-4.d0)))
call test_z (cdsqrt, (1.2d0,-4.d0), cdsqrt((1.2d0,-4.d0)))
call test_z (zsqrt, (1.2d0,-4.d0), zsqrt((1.2d0,-4.d0)))
call test_cabs (cabs, (1.2,-4.), cabs((1.2,-4.)))
call test_cdabs (cdabs, (1.2d0,-4.d0), cdabs((1.2d0,-4.d0)))
call test_cdabs (zabs, (1.2d0,-4.d0), zabs((1.2d0,-4.d0)))
call test_cabs (aimag, (1.2,-4.), aimag((1.2,-4.)))
call test_cdabs (dimag, (1.2d0,-4.d0), dimag((1.2d0,-4.d0)))
call test_nint (nint, -1.2, nint(-1.2))
call test_idnint (idnint, -1.2d0, idnint(-1.2d0))
call test_idim (isign, -42, 17, isign(-42, 17))
call test_idim (idim, -42, 17, idim(-42,17))
call test_idim (idim, 42, 17, idim(42,17))
call test_r2 (dim, 1.2, -4., dim(1.2, -4.))
call test_d2 (ddim, 1.2d0, -4.d0, ddim(1.2d0, -4.d0))
call test_iabs (iabs, -7, iabs(-7))
call test_idim (mod, 5, 2, mod(5,2))
call test_len (len, "foobar", len("foobar"))
call test_index (index, "foobarfoobar", "bar", index("foobarfoobar","bar"))
end program