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