OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/33197 (Fortran 2008: math functions) 

2009-07-25  Tobias Burnus  <burnus@net-b.de>
            Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

        PR fortran/33197
        * intrinsic.c (add_functions): Support complex arguments for
        acos,acosh,asin,asinh,atan,atanh.
        * invoke.texi (ACOS,ACOSH,ASIN,ASINH,ATAN,ATANH): Support
        complex arguments.
        * simplify.c (gfc_simplify_acos,gfc_simplify_acosh,
        gfc_simplify_asin,gfc_simplify_asinh,gfc_simplify_atan,
        gfc_simplify_atanh,gfc_simplify_atan,gfc_simplify_asinh,
        gfc_simplify_acosh,gfc_simplify_atanh): Support
        complex arguments.

2009-07-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * intrinsics/c99_functions.c (cacosf,cacos,cacosl,casinf,
        casin,casind,catanf,catan,catanl,cacoshf,cacosh,cacoshl,
        casinhf,casinh,casinhf,catanhf,catanh,catanhl): New functions.
        * c99_protos.h: Add prototypes for those.

2009-07-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gfortran.dg/complex_intrinsic_5.f90: New test.
        * gfortran.dg/complex_intrinsic_7.f90: New test.


Co-Authored-By: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>

From-SVN: r150087
This commit is contained in:
Tobias Burnus 2009-07-25 21:39:07 +02:00 committed by Tobias Burnus
parent 86631ea3dd
commit 504ed63a1a
11 changed files with 814 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
2009-07-25 Tobias Burnus <burnus@net-b.de>
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33197
* intrinsic.c (add_functions): Support complex arguments for
acos,acosh,asin,asinh,atan,atanh.
* invoke.texi (ACOS,ACOSH,ASIN,ASINH,ATAN,ATANH): Support
complex arguments.
* simplify.c (gfc_simplify_acos,gfc_simplify_acosh,
gfc_simplify_asin,gfc_simplify_asinh,gfc_simplify_atan,
gfc_simplify_atanh,gfc_simplify_atan,gfc_simplify_asinh,
gfc_simplify_acosh,gfc_simplify_atanh): Support
complex arguments.
2009-07-25 Richard Guenther <rguenther@suse.de>
PR fortran/40005

12
gcc/fortran/intrinsic.c
View File

@ -1134,7 +1134,7 @@ add_functions (void)
make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
@ -1144,7 +1144,7 @@ add_functions (void)
make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_acosh,
GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
@ -1217,7 +1217,7 @@ add_functions (void)
make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
@ -1227,7 +1227,7 @@ add_functions (void)
make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_asinh,
GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
@ -1243,7 +1243,7 @@ add_functions (void)
make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
@ -1253,7 +1253,7 @@ add_functions (void)
make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_atanh,
GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,

51
gcc/fortran/intrinsic.texi
View File

@ -531,7 +531,7 @@ and formatted string representations.
@code{ACOS(X)} computes the arccosine of @var{X} (inverse of @code{COS(X)}).
@item @emph{Standard}:
Fortran 77 and later
Fortran 77 and later, for a complex argument Fortran 2008 or later
@item @emph{Class}:
Elemental function
@ -541,14 +541,14 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL} with a magnitude that is
less than or equal to one.
@item @var{X} @tab The type shall either be @code{REAL} with a magnitude that is
less than or equal to one - or the type shall be @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL} and it lies in the
range @math{ 0 \leq \acos(x) \leq \pi}. The return value if of the same
kind as @var{X}.
The return value is of the same type and kind as @var{X}.
The real part of the result is in radians and lies in the range
@math{0 \leq \Re \acos(x) \leq \pi}.
@item @emph{Example}:
@smallexample
@ -600,7 +600,9 @@ Elemental function
@end multitable
@item @emph{Return value}:
The return value has the same type and kind as @var{X}
The return value has the same type and kind as @var{X}. If @var{X} is
complex, the imaginary part of the result is in radians and lies between
@math{ 0 \leq \Im \acosh(x) \leq \pi}.
@item @emph{Example}:
@smallexample
@ -1170,7 +1172,7 @@ end program test_any
@code{ASIN(X)} computes the arcsine of its @var{X} (inverse of @code{SIN(X)}).
@item @emph{Standard}:
Fortran 77 and later
Fortran 77 and later, for a complex argument Fortran 2008 or later
@item @emph{Class}:
Elemental function
@ -1180,14 +1182,14 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL}, and a magnitude that is
less than or equal to one.
@item @var{X} @tab The type shall be either @code{REAL} and a magnitude that is
less than or equal to one - or be @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL} and it lies in the
range @math{-\pi / 2 \leq \asin (x) \leq \pi / 2}. The kind type
parameter is the same as @var{X}.
The return value is of the same type and kind as @var{X}.
The real part of the result is in radians and lies in the range
@math{-\pi/2 \leq \Re \asin(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@ -1238,7 +1240,9 @@ Elemental function
@end multitable
@item @emph{Return value}:
The return value is of the same type and kind as @var{X}.
The return value is of the same type and kind as @var{X}. If @var{X} is
complex, the imaginary part of the result is in radians and lies between
@math{-\pi/2 \leq \Im \asinh(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@ -1349,7 +1353,7 @@ end program test_associated
@code{ATAN(X)} computes the arctangent of @var{X}.
@item @emph{Standard}:
Fortran 77 and later
Fortran 77 and later, for a complex argument Fortran 2008 or later
@item @emph{Class}:
Elemental function
@ -1359,12 +1363,13 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab The type shall be @code{REAL}.
@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL} and it lies in the
range @math{ - \pi / 2 \leq \atan (x) \leq \pi / 2}.
The return value is of the same type and kind as @var{X}.
The real part of the result is in radians and lies in the range
@math{-\pi/2 \leq \Re \atan(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@ -1470,7 +1475,9 @@ Elemental function
@end multitable
@item @emph{Return value}:
The return value has same type and kind as @var{X}.
The return value has same type and kind as @var{X}. If @var{X} is
complex, the imaginary part of the result is in radians and lies between
@math{-\pi/2 \leq \Im \atanh(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@ -2635,9 +2642,9 @@ Elemental function
@end multitable
@item @emph{Return value}:
The return value is of type @code{REAL} and it lies in the
range @math{ -1 \leq \cos (x) \leq 1}. The kind type
parameter is the same as @var{X}.
The return value is of the same type and kind as @var{X}. The real part
of the result is in radians. If @var{X} is of the type @code{REAL},
the return value lies in the range @math{ -1 \leq \cos (x) \leq 1}.
@item @emph{Example}:
@smallexample

182
gcc/fortran/simplify.c
View File

@ -735,12 +735,21 @@ gfc_simplify_acos (gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT)
return NULL;
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
switch (x->ts.type)
{
gfc_error ("Argument of ACOS at %L must be between -1 and 1",
&x->where);
return &gfc_bad_expr;
case BT_REAL:
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
{
gfc_error ("Argument of ACOS at %L must be between -1 and 1",
&x->where);
return &gfc_bad_expr;
}
break;
case BT_COMPLEX:
return NULL;
default:
gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
@ -758,17 +767,25 @@ gfc_simplify_acosh (gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT)
return NULL;
if (mpfr_cmp_si (x->value.real, 1) < 0)
switch (x->ts.type)
{
gfc_error ("Argument of ACOSH at %L must not be less than 1",
&x->where);
return &gfc_bad_expr;
case BT_REAL:
if (mpfr_cmp_si (x->value.real, 1) < 0)
{
gfc_error ("Argument of ACOSH at %L must not be less than 1",
&x->where);
return &gfc_bad_expr;
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
return NULL;
default:
gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
return range_check (result, "ACOSH");
}
@ -1012,18 +1029,25 @@ gfc_simplify_asin (gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT)
return NULL;
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
switch (x->ts.type)
{
gfc_error ("Argument of ASIN at %L must be between -1 and 1",
&x->where);
return &gfc_bad_expr;
case BT_REAL:
if (mpfr_cmp_si (x->value.real, 1) > 0
|| mpfr_cmp_si (x->value.real, -1) < 0)
{
gfc_error ("Argument of ASIN at %L must be between -1 and 1",
&x->where);
return &gfc_bad_expr;
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
return NULL;
default:
gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
return range_check (result, "ASIN");
}
@ -1036,9 +1060,17 @@ gfc_simplify_asinh (gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT)
return NULL;
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
switch (x->ts.type)
{
case BT_REAL:
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
return NULL;
default:
gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
return range_check (result, "ASINH");
}
@ -1052,9 +1084,17 @@ gfc_simplify_atan (gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT)
return NULL;
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
switch (x->ts.type)
{
case BT_REAL:
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
return NULL;
default:
gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
return range_check (result, "ATAN");
}
@ -1068,18 +1108,26 @@ gfc_simplify_atanh (gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT)
return NULL;
if (mpfr_cmp_si (x->value.real, 1) >= 0
|| mpfr_cmp_si (x->value.real, -1) <= 0)
switch (x->ts.type)
{
gfc_error ("Argument of ATANH at %L must be inside the range -1 to 1",
&x->where);
return &gfc_bad_expr;
case BT_REAL:
if (mpfr_cmp_si (x->value.real, 1) >= 0
|| mpfr_cmp_si (x->value.real, -1) <= 0)
{
gfc_error ("Argument of ATANH at %L must be inside the range -1 "
"to 1", &x->where);
return &gfc_bad_expr;
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
return NULL;
default:
gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
return range_check (result, "ATANH");
}
@ -1501,7 +1549,19 @@ gfc_simplify_cosh (gfc_expr *x)
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_cosh (result->value.real, x->value.real, GFC_RND_MODE);
if (x->ts.type == BT_REAL)
mpfr_cosh (result->value.real, x->value.real, GFC_RND_MODE);
else if (x->ts.type == BT_COMPLEX)
{
#if HAVE_mpc
mpc_cosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
#else
gfc_free_expr (result);
return NULL;
#endif
}
else
gcc_unreachable ();
return range_check (result, "COSH");
}
@ -5033,7 +5093,20 @@ gfc_simplify_sinh (gfc_expr *x)
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_sinh (result->value.real, x->value.real, GFC_RND_MODE);
if (x->ts.type == BT_REAL)
mpfr_sinh (result->value.real, x->value.real, GFC_RND_MODE);
else if (x->ts.type == BT_COMPLEX)
{
#if HAVE_mpc
mpc_sinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
#else
gfc_free_expr (result);
return NULL;
#endif
}
else
gcc_unreachable ();
return range_check (result, "SINH");
}
@ -5344,17 +5417,26 @@ gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
gfc_expr *
gfc_simplify_tan (gfc_expr *x)
{
int i;
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_tan (result->value.real, x->value.real, GFC_RND_MODE);
if (x->ts.type == BT_REAL)
mpfr_tan (result->value.real, x->value.real, GFC_RND_MODE);
else if (x->ts.type == BT_COMPLEX)
{
#if HAVE_mpc
mpc_tan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
#else
gfc_free_expr (result);
return NULL;
#endif
}
else
gcc_unreachable ();
return range_check (result, "TAN");
}
@ -5370,7 +5452,19 @@ gfc_simplify_tanh (gfc_expr *x)
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_tanh (result->value.real, x->value.real, GFC_RND_MODE);
if (x->ts.type == BT_REAL)
mpfr_tanh (result->value.real, x->value.real, GFC_RND_MODE);
else if (x->ts.type == BT_COMPLEX)
{
#if HAVE_mpc
mpc_tanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
#else
gfc_free_expr (result);
return NULL;
#endif
}
else
gcc_unreachable ();
return range_check (result, "TANH");

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2009-07-25 Tobias Burnus <burnus@net-b.de>
PR fortran/33197
* gfortran.dg/complex_intrinsic_5.f90: New test.
* gfortran.dg/complex_intrinsic_7.f90: New test.
2009-07-25 Martin Jambor <mjambor@suse.cz>
* gcc.c-torture/execute/pr17377.c: Add noclone attribute to function y.

221
gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 Normal file
View File

@ -0,0 +1,221 @@
! { dg-do run }
!
! PR fortran/33197
!
! Complex inverse trigonometric functions
! and complex inverse hyperbolic functions
!
! Run-time evaluation check
!
module test
implicit none
real(4), parameter :: eps4 = epsilon(0.0_4)*2.0_4
real(8), parameter :: eps8 = epsilon(0.0_8)*2.0_8
interface check
procedure check4, check8
end interface check
contains
SUBROUTINE check4(z, zref)
complex(4), intent(in) :: z, zref
if ( abs (real(z)-real(zref)) > eps4 &
.or.abs (aimag(z)-aimag(zref)) > eps4) then
print '(a,/,2((2g0," + I ",g0),/))', "check4:"," z=",z,'zref=',zref
print '(a,g0," + I*",g0," eps=",g0)', 'Diff: ', &
real(z)-real(zref), &
aimag(z)-aimag(zref), eps4
call abort()
end if
END SUBROUTINE check4
SUBROUTINE check8(z, zref)
complex(8), intent(in) :: z, zref
if ( abs (real(z)-real(zref)) > eps8 &
.or.abs (aimag(z)-aimag(zref)) > eps8) then
print '(a,/,2((2g0," + I ",g0),/))', "check8:"," z=",z,'zref=',zref
print '(a,g0," + I*",g0," eps=",g0)', 'Diff: ', &
real(z)-real(zref), &
aimag(z)-aimag(zref), eps8
call abort()
end if
END SUBROUTINE check8
end module test
PROGRAM ArcTrigHyp
use test
IMPLICIT NONE
complex(4), volatile :: z4
complex(8), volatile :: z8
!!!!! ZERO !!!!!!
! z = 0
z4 = cmplx(0.0_4, 0.0_4, kind=4)
z8 = cmplx(0.0_8, 0.0_8, kind=8)
! Exact: 0
call check(asin(z4), cmplx(0.0_4, 0.0_4, kind=4))
call check(asin(z8), cmplx(0.0_8, 0.0_8, kind=8))
! Exact: Pi/2 = 1.5707963267948966192313216916397514
call check(acos(z4), cmplx(1.57079632679489661920_4, 0.0_4, kind=4))
call check(acos(z8), cmplx(1.57079632679489661920_8, 0.0_8, kind=8))
! Exact: 0
call check(atan(z4), cmplx(0.0_4, 0.0_4, kind=4))
call check(atan(z8), cmplx(0.0_8, 0.0_8, kind=8))
! Exact: 0
call check(asinh(z4), cmplx(0.0_4, 0.0_4, kind=4))
call check(asinh(z8), cmplx(0.0_8, 0.0_8, kind=8))
! Exact: I*Pi/2 = I*1.5707963267948966192313216916397514
call check(acosh(z4), cmplx(0.0_4, 1.57079632679489661920_4, kind=4))
call check(acosh(z8), cmplx(0.0_8, 1.57079632679489661920_8, kind=8))
! Exact: 0
call check(atanh(z4), cmplx(0.0_4, 0.0_4, kind=4))
call check(atanh(z8), cmplx(0.0_8, 0.0_8, kind=8))
!!!!! POSITIVE NUMBERS !!!!!!
! z = tanh(1.0)
z4 = cmplx(0.76159415595576488811945828260479359_4, 0.0_4, kind=4)
z8 = cmplx(0.76159415595576488811945828260479359_8, 0.0_8, kind=8)
! Numerically: 0.86576948323965862428960184619184444
call check(asin(z4), cmplx(0.86576948323965862428960184619184444_4, 0.0_4, kind=4))
call check(asin(z8), cmplx(0.86576948323965862428960184619184444_8, 0.0_8, kind=8))
! Numerically: 0.70502684355523799494171984544790700
call check(acos(z4), cmplx(0.70502684355523799494171984544790700_4, 0.0_4, kind=4))
call check(acos(z8), cmplx(0.70502684355523799494171984544790700_8, 0.0_8, kind=8))
! Numerically: 0.65088016802300754993807813168285564
call check(atan(z4), cmplx(0.65088016802300754993807813168285564_4, 0.0_4, kind=4))
call check(atan(z8), cmplx(0.65088016802300754993807813168285564_8, 0.0_8, kind=8))
! Numerically: 0.70239670712987482778422106260749699
call check(asinh(z4), cmplx(0.70239670712987482778422106260749699_4, 0.0_4, kind=4))
call check(asinh(z8), cmplx(0.70239670712987482778422106260749699_8, 0.0_8, kind=8))
! Numerically: 0.70502684355523799494171984544790700*I
call check(acosh(z4), cmplx(0.0_4, 0.70502684355523799494171984544790700_4, kind=4))
call check(acosh(z8), cmplx(0.0_8, 0.70502684355523799494171984544790700_8, kind=8))
! Exact: 1
call check(atanh(z4), cmplx(1.0_4, 0.0_4, kind=4))
call check(atanh(z8), cmplx(1.0_8, 0.0_8, kind=8))
! z = I*tanh(1.0)
z4 = cmplx(0.0_4, 0.76159415595576488811945828260479359_4, kind=4)
z8 = cmplx(0.0_8, 0.76159415595576488811945828260479359_8, kind=8)
! Numerically: I*0.70239670712987482778422106260749699
call check(asin(z4), cmplx(0.0_4, 0.70239670712987482778422106260749699_4, kind=4))
call check(asin(z8), cmplx(0.0_8, 0.70239670712987482778422106260749699_8, kind=8))
! Numerically: 1.5707963267948966192313216916397514 - I*0.7023967071298748277842210626074970
call check(acos(z4), cmplx(1.5707963267948966192313216916397514_4, -0.7023967071298748277842210626074970_4, kind=4))
call check(acos(z8), cmplx(1.5707963267948966192313216916397514_8, -0.7023967071298748277842210626074970_8, kind=8))
! Exact: I*1
call check(atan(z4), cmplx(0.0_4, 1.0_4, kind=4))
call check(atan(z8), cmplx(0.0_8, 1.0_8, kind=8))
! Numerically: I*0.86576948323965862428960184619184444
call check(asinh(z4), cmplx(0.0_4, 0.86576948323965862428960184619184444_4, kind=4))
call check(asinh(z8), cmplx(0.0_8, 0.86576948323965862428960184619184444_8, kind=8))
! Numerically: 0.7023967071298748277842210626074970 + I*1.5707963267948966192313216916397514
call check(acosh(z4), cmplx(0.7023967071298748277842210626074970_4, 1.5707963267948966192313216916397514_4, kind=4))
call check(acosh(z8), cmplx(0.7023967071298748277842210626074970_8, 1.5707963267948966192313216916397514_8, kind=8))
! Numerically: I*0.65088016802300754993807813168285564
call check(atanh(z4), cmplx(0.0_4, 0.65088016802300754993807813168285564_4, kind=4))
call check(atanh(z8), cmplx(0.0_8, 0.65088016802300754993807813168285564_8, kind=8))
! z = (1+I)*tanh(1.0)
z4 = cmplx(0.76159415595576488811945828260479359_4, 0.76159415595576488811945828260479359_4, kind=4)
z8 = cmplx(0.76159415595576488811945828260479359_8, 0.76159415595576488811945828260479359_8, kind=8)
! Numerically: 0.59507386031622633330574869409179139 + I*0.82342412550090412964986631390412834
call check(asin(z4), cmplx(0.59507386031622633330574869409179139_4, 0.82342412550090412964986631390412834_4, kind=4))
call check(asin(z8), cmplx(0.59507386031622633330574869409179139_8, 0.82342412550090412964986631390412834_8, kind=8))
! Numerically: 0.97572246647867028592557299754796005 - I*0.82342412550090412964986631390412834
call check(acos(z4), cmplx(0.97572246647867028592557299754796005_4, -0.82342412550090412964986631390412834_4, kind=4))
call check(acos(z8), cmplx(0.97572246647867028592557299754796005_8, -0.82342412550090412964986631390412834_8, kind=8))
! Numerically: 0.83774433133636226305479129936568267 + I*0.43874835208710654149508159123595167
call check(atan(z4), cmplx(0.83774433133636226305479129936568267_4, 0.43874835208710654149508159123595167_4, kind=4))
call check(atan(z8), cmplx(0.83774433133636226305479129936568267_8, 0.43874835208710654149508159123595167_8, kind=8))
! Numerically: 0.82342412550090412964986631390412834 + I*0.59507386031622633330574869409179139
call check(asinh(z4), cmplx(0.82342412550090412964986631390412834_4, 0.59507386031622633330574869409179139_4, kind=4))
call check(asinh(z8), cmplx(0.82342412550090412964986631390412834_8, 0.59507386031622633330574869409179139_8, kind=8))
! Numerically: 0.82342412550090412964986631390412834 + I*0.97572246647867028592557299754796005
call check(acosh(z4), cmplx(0.82342412550090412964986631390412834_4, 0.97572246647867028592557299754796005_4, kind=4))
call check(acosh(z8), cmplx(0.82342412550090412964986631390412834_8, 0.97572246647867028592557299754796005_8, kind=8))
! Numerically: 0.43874835208710654149508159123595167 + I*0.83774433133636226305479129936568267
call check(atanh(z4), cmplx(0.43874835208710654149508159123595167_4, 0.83774433133636226305479129936568267_4, kind=4))
call check(atanh(z8), cmplx(0.43874835208710654149508159123595167_8, 0.83774433133636226305479129936568267_8, kind=8))
! z = 1+I
z4 = cmplx(1.0_4, 1.0_4, kind=4)
z8 = cmplx(1.0_8, 1.0_8, kind=8)
! Numerically: 0.66623943249251525510400489597779272 + I*1.06127506190503565203301891621357349
call check(asin(z4), cmplx(0.66623943249251525510400489597779272_4, 1.06127506190503565203301891621357349_4, kind=4))
call check(asin(z8), cmplx(0.66623943249251525510400489597779272_8, 1.06127506190503565203301891621357349_8, kind=8))
! Numerically: 0.90455689430238136412731679566195872 - I*1.06127506190503565203301891621357349
call check(acos(z4), cmplx(0.90455689430238136412731679566195872_4, -1.06127506190503565203301891621357349_4, kind=4))
call check(acos(z8), cmplx(0.90455689430238136412731679566195872_8, -1.06127506190503565203301891621357349_8, kind=8))
! Numerically: 1.01722196789785136772278896155048292 + I*0.40235947810852509365018983330654691
call check(atan(z4), cmplx(1.01722196789785136772278896155048292_4, 0.40235947810852509365018983330654691_4, kind=4))
call check(atan(z8), cmplx(1.01722196789785136772278896155048292_8, 0.40235947810852509365018983330654691_8, kind=8))
! Numerically: 1.06127506190503565203301891621357349 + I*0.66623943249251525510400489597779272
call check(asinh(z4), cmplx(1.06127506190503565203301891621357349_4, 0.66623943249251525510400489597779272_4, kind=4))
call check(asinh(z8), cmplx(1.06127506190503565203301891621357349_8, 0.66623943249251525510400489597779272_8, kind=8))
! Numerically: 1.06127506190503565203301891621357349 + I*0.90455689430238136412731679566195872
call check(acosh(z4), cmplx(1.06127506190503565203301891621357349_4, 0.90455689430238136412731679566195872_4, kind=4))
call check(acosh(z8), cmplx(1.06127506190503565203301891621357349_8, 0.90455689430238136412731679566195872_8, kind=8))
! Numerically: 0.40235947810852509365018983330654691 + I*1.01722196789785136772278896155048292
call check(atanh(z4), cmplx(0.40235947810852509365018983330654691_4, 1.01722196789785136772278896155048292_4, kind=4))
call check(atanh(z8), cmplx(0.40235947810852509365018983330654691_8, 1.01722196789785136772278896155048292_8, kind=8))
! z = (1+I)*1.1
z4 = cmplx(1.1_4, 1.1_4, kind=4)
z8 = cmplx(1.1_8, 1.1_8, kind=8)
! Numerically: 0.68549840630267734494444454677951503 + I*1.15012680127435581678415521738176733
call check(asin(z4), cmplx(0.68549840630267734494444454677951503_4, 1.15012680127435581678415521738176733_4, kind=4))
call check(asin(z8), cmplx(0.68549840630267734494444454677951503_8, 1.15012680127435581678415521738176733_8, kind=8))
! Numerically: 0.8852979204922192742868771448602364 - I*1.1501268012743558167841552173817673
call check(acos(z4), cmplx(0.8852979204922192742868771448602364_4, -1.1501268012743558167841552173817673_4, kind=4))
call check(acos(z8), cmplx(0.8852979204922192742868771448602364_8, -1.1501268012743558167841552173817673_8, kind=8))
! Numerically: 1.07198475450905931839240655913126728 + I*0.38187020129010862908881230531688930
call check(atan(z4), cmplx(1.07198475450905931839240655913126728_4, 0.38187020129010862908881230531688930_4, kind=4))
call check(atan(z8), cmplx(1.07198475450905931839240655913126728_8, 0.38187020129010862908881230531688930_8, kind=8))
! Numerically: 1.15012680127435581678415521738176733 + I*0.68549840630267734494444454677951503
call check(asinh(z4), cmplx(1.15012680127435581678415521738176733_4, 0.68549840630267734494444454677951503_4, kind=4))
call check(asinh(z8), cmplx(1.15012680127435581678415521738176733_8, 0.68549840630267734494444454677951503_8, kind=8))
! Numerically: 1.1501268012743558167841552173817673 + I*0.8852979204922192742868771448602364
call check(acosh(z4), cmplx(1.1501268012743558167841552173817673_4, 0.8852979204922192742868771448602364_4, kind=4))
call check(acosh(z8), cmplx(1.1501268012743558167841552173817673_8, 0.8852979204922192742868771448602364_8, kind=8))
! Numerically: 0.38187020129010862908881230531688930 + I*1.07198475450905931839240655913126728
call check(atanh(z4), cmplx(0.38187020129010862908881230531688930_4, 1.07198475450905931839240655913126728_4, kind=4))
call check(atanh(z8), cmplx(0.38187020129010862908881230531688930_8, 1.07198475450905931839240655913126728_8, kind=8))
!!!!! Negative NUMBERS !!!!!!
! z = -(1+I)*1.1
z4 = cmplx(-1.1_4, -1.1_4, kind=4)
z8 = cmplx(-1.1_8, -1.1_8, kind=8)
! Numerically: -0.68549840630267734494444454677951503 - I*1.15012680127435581678415521738176733
call check(asin(z4), cmplx(-0.68549840630267734494444454677951503_4, -1.15012680127435581678415521738176733_4, kind=4))
call check(asin(z8), cmplx(-0.68549840630267734494444454677951503_8, -1.15012680127435581678415521738176733_8, kind=8))
! Numerically: 2.2562947330975739641757662384192665 + I*1.1501268012743558167841552173817673
call check(acos(z4), cmplx(2.2562947330975739641757662384192665_4, 1.1501268012743558167841552173817673_4, kind=4))
call check(acos(z8), cmplx(2.2562947330975739641757662384192665_8, 1.1501268012743558167841552173817673_8, kind=8))
! Numerically: -1.07198475450905931839240655913126728 - I*0.38187020129010862908881230531688930
call check(atan(z4), cmplx(-1.07198475450905931839240655913126728_4, -0.38187020129010862908881230531688930_4, kind=4))
call check(atan(z8), cmplx(-1.07198475450905931839240655913126728_8, -0.38187020129010862908881230531688930_8, kind=8))
! Numerically: -1.15012680127435581678415521738176733 - I*0.68549840630267734494444454677951503
call check(asinh(z4), cmplx(-1.15012680127435581678415521738176733_4, -0.68549840630267734494444454677951503_4, kind=4))
call check(asinh(z8), cmplx(-1.15012680127435581678415521738176733_8, -0.68549840630267734494444454677951503_8, kind=8))
! Numerically: 1.1501268012743558167841552173817673 - I*2.2562947330975739641757662384192665
call check(acosh(z4), cmplx(1.1501268012743558167841552173817673_4, -2.2562947330975739641757662384192665_4, kind=4))
call check(acosh(z8), cmplx(1.1501268012743558167841552173817673_8, -2.2562947330975739641757662384192665_8, kind=8))
! Numerically: 0.38187020129010862908881230531688930 + I*1.07198475450905931839240655913126728
call check(atanh(z4), cmplx(-0.38187020129010862908881230531688930_4, -1.07198475450905931839240655913126728_4, kind=4))
call check(atanh(z8), cmplx(-0.38187020129010862908881230531688930_8, -1.07198475450905931839240655913126728_8, kind=8))
END PROGRAM ArcTrigHyp
! { dg-final { cleanup-modules "test" } }

41
gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 Normal file
View File

@ -0,0 +1,41 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/33197
! PR fortran/40728
!
! Complex inverse trigonometric functions
! and complex inverse hyperbolic functions
!
! Argument type check
!
PROGRAM ArcTrigHyp
IMPLICIT NONE
real(4), volatile :: r4
real(8), volatile :: r8
complex(4), volatile :: z4
complex(8), volatile :: z8
r4 = 0.0_4
r8 = 0.0_8
z4 = cmplx(0.0_4, 0.0_4, kind=4)
z8 = cmplx(0.0_8, 0.0_8, kind=8)
r4 = asin(r4)
r8 = asin(r8)
r4 = acos(r4)
r8 = acos(r8)
r4 = atan(r4)
r8 = atan(r8)
! a(sin,cos,tan)h cannot be checked as they are not part of
! Fortran 2003 - not even for real arguments
z4 = asin(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
z8 = asin(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
z4 = acos(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
z8 = acos(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
z4 = atan(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
z8 = atan(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
END PROGRAM ArcTrigHyp

45
gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 Normal file
View File

@ -0,0 +1,45 @@
! { dg-do compile }
! { dg-require-effective-target mpc }
! { dg-options "-fdump-tree-original" }
!
! PR fortran/33197
!
! Fortran 2008 complex trigonometric functions: tan, cosh, sinh, tanh
!
! Compile-time simplificiations
!
implicit none
real(4), parameter :: pi = 2*acos(0.0_4)
real(8), parameter :: pi8 = 2*acos(0.0_8)
real(4), parameter :: eps = 10*epsilon(0.0_4)
real(8), parameter :: eps8 = 10*epsilon(0.0_8)
complex(4), parameter :: z0_0 = cmplx(0.0_4, 0.0_4, kind=4)
complex(4), parameter :: z1_1 = cmplx(1.0_4, 1.0_4, kind=4)
complex(4), parameter :: zp_p = cmplx(pi, pi, kind=4)
complex(8), parameter :: z80_0 = cmplx(0.0_8, 0.0_8, kind=8)
complex(8), parameter :: z81_1 = cmplx(1.0_8, 1.0_8, kind=8)
complex(8), parameter :: z8p_p = cmplx(pi8, pi8, kind=8)
if (abs(tan(z0_0) - cmplx(0.0,0.0,4)) > eps) call abort()
if (abs(tan(z1_1) - cmplx(0.27175257,1.0839232,4)) > eps) call abort()
if (abs(tan(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
if (abs(tan(z81_1) - cmplx(0.27175258531951174_8,1.0839233273386946_8,8)) > eps8) call abort()
if (abs(cosh(z0_0) - cmplx(1.0,0.0,4)) > eps) call abort()
if (abs(cosh(z1_1) - cmplx(0.83372992,0.98889768,4)) > eps) call abort()
if (abs(cosh(z80_0) - cmplx(1.0_8,0.0_8,8)) > eps8) call abort()
if (abs(cosh(z81_1) - cmplx(0.83373002513114913_8,0.98889770576286506_8,8)) > eps8) call abort()
if (abs(sinh(z0_0) - cmplx(0.0,0.0,4)) > eps) call abort()
if (abs(sinh(z1_1) - cmplx(0.63496387,1.2984575,4)) > eps) call abort()
if (abs(sinh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
if (abs(sinh(z81_1) - cmplx(0.63496391478473613_8,1.2984575814159773_8,8)) > eps8) call abort()
if (abs(tanh(z0_0) - cmplx(0.0,0.0,4)) > eps) call abort()
if (abs(tanh(z1_1) - cmplx(1.0839232,0.27175257,4)) > eps) call abort()
if (abs(tanh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
if (abs(tanh(z81_1) - cmplx(1.0839233273386946_8,0.27175258531951174_8,8)) > eps8) call abort()
end
! { dg-final { scan-tree-dump-times "abort" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2009-07-25 Tobias Burnus <burnus@net-b.de>
PR fortran/33197
* intrinsics/c99_functions.c (cacosf,cacos,cacosl,casinf,
casin,casind,catanf,catan,catanl,cacoshf,cacosh,cacoshl,
casinhf,casinh,casinhf,catanhf,catanh,catanhl): New functions.
* c99_protos.h: Add prototypes for those.
2009-07-24 Jakub Jelinek <jakub@redhat.com>
PR fortran/40643

109
libgfortran/c99_protos.h
View File

@ -498,6 +498,115 @@ extern long double complex ctanl (long double complex);
#endif
/* Complex ACOS. */
#if !defined(HAVE_CACOSF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CACOSF 1
extern complex float cacosf (complex float z);
#endif
#if !defined(HAVE_CACOS) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CACOS 1
extern complex double cacos (complex double z);
#endif
#if !defined(HAVE_CACOSL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CACOSL 1
extern complex long double cacosl (complex long double z);
#endif
/* Complex ASIN. */
#if !defined(HAVE_CASINF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CASINF 1
extern complex float casinf (complex float z);
#endif
#if !defined(HAVE_CASIN) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CASIN 1
extern complex double casin (complex double z);
#endif
#if !defined(HAVE_CASINL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CASINL 1
extern complex long double casinl (complex long double z);
#endif
/* Complex ATAN. */
#if !defined(HAVE_CATANF) && defined(HAVE_CLOGF)
#define HAVE_CATANF 1
extern complex float catanf (complex float z);
#endif
#if !defined(HAVE_CATAN) && defined(HAVE_CLOG)
#define HAVE_CATAN 1
extern complex double catan (complex double z);
#endif
#if !defined(HAVE_CATANL) && defined(HAVE_CLOGL)
#define HAVE_CATANL 1
extern complex long double catanl (complex long double z);
#endif
/* Complex ASINH. */
#if !defined(HAVE_CASINHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CASINHF 1
extern complex float casinhf (complex float z);
#endif
#if !defined(HAVE_CASINH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CASINH 1
extern complex double casinh (complex double z);
#endif
#if !defined(HAVE_CASINHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CASINHL 1
extern complex long double casinhl (complex long double z);
#endif
/* Complex ACOSH. */
#if !defined(HAVE_CACOSHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CACOSHF 1
extern complex float cacoshf (complex float z);
#endif
#if !defined(HAVE_CACOSH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CACOSH 1
extern complex double cacosh (complex double z);
#endif
#if !defined(HAVE_CACOSHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CACOSHL 1
extern complex long double cacoshl (complex long double z);
#endif
/* Complex ATANH. */
#if !defined(HAVE_CATANHF) && defined(HAVE_CLOGF)
#define HAVE_CATANHF 1
extern complex float catanhf (complex float z);
#endif
#if !defined(HAVE_CATANH) && defined(HAVE_CLOG)
#define HAVE_CATANH 1
extern complex double catanh (complex double z);
#endif
#if !defined(HAVE_CATANHL) && defined(HAVE_CLOGL)
#define HAVE_CATANHL 1
extern complex long double catanhl (complex long double z);
#endif
/* Gamma-related prototypes. */
#if !defined(HAVE_TGAMMA)
#define HAVE_TGAMMA 1

197
libgfortran/intrinsics/c99_functions.c
View File

@ -1412,6 +1412,203 @@ ctanl (long double complex a)
#endif
/* Complex ASIN. Returns wrongly NaN for infinite arguments.
Algorithm taken from Abramowitz & Stegun. */
#if !defined(HAVE_CASINF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CASINF 1
complex float
casinf (complex float z)
{
return -I*clogf (I*z + csqrtf (1.0f-z*z));
}
#endif
#if !defined(HAVE_CASIN) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CASIN 1
complex double
casin (complex double z)
{
return -I*clog (I*z + csqrt (1.0-z*z));
}
#endif
#if !defined(HAVE_CASINL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CASINL 1
complex long double
casinl (complex long double z)
{
return -I*clogl (I*z + csqrtl (1.0L-z*z));
}
#endif
/* Complex ACOS. Returns wrongly NaN for infinite arguments.
Algorithm taken from Abramowitz & Stegun. */
#if !defined(HAVE_CACOSF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CACOSF 1
complex float
cacosf (complex float z)
{
return -I*clogf (z + I*csqrtf(1.0f-z*z));
}
#endif
complex double
#if !defined(HAVE_CACOS) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CACOS 1
cacos (complex double z)
{
return -I*clog (z + I*csqrt (1.0-z*z));
}
#endif
#if !defined(HAVE_CACOSL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CACOSL 1
complex long double
cacosl (complex long double z)
{
return -I*clogl (z + I*csqrtl (1.0L-z*z));
}
#endif
/* Complex ATAN. Returns wrongly NaN for infinite arguments.
Algorithm taken from Abramowitz & Stegun. */
#if !defined(HAVE_CATANF) && defined(HAVE_CLOGF)
#define HAVE_CACOSF 1
complex float
catanf (complex float z)
{
return I*clogf ((I+z)/(I-z))/2.0f;
}
#endif
#if !defined(HAVE_CATAN) && defined(HAVE_CLOG)
#define HAVE_CACOS 1
complex double
catan (complex double z)
{
return I*clog ((I+z)/(I-z))/2.0;
}
#endif
#if !defined(HAVE_CATANL) && defined(HAVE_CLOGL)
#define HAVE_CACOSL 1
complex long double
catanl (complex long double z)
{
return I*clogl ((I+z)/(I-z))/2.0L;
}
#endif
/* Complex ASINH. Returns wrongly NaN for infinite arguments.
Algorithm taken from Abramowitz & Stegun. */
#if !defined(HAVE_CASINHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CASINHF 1
complex float
casinhf (complex float z)
{
return clogf (z + csqrtf (z*z+1.0f));
}
#endif
#if !defined(HAVE_CASINH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CASINH 1
complex double
casinh (complex double z)
{
return clog (z + csqrt (z*z+1.0));
}
#endif
#if !defined(HAVE_CASINHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CASINHL 1
complex long double
casinhl (complex long double z)
{
return clogl (z + csqrtl (z*z+1.0L));
}
#endif
/* Complex ACOSH. Returns wrongly NaN for infinite arguments.
Algorithm taken from Abramowitz & Stegun. */
#if !defined(HAVE_CACOSHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
#define HAVE_CACOSHF 1
complex float
cacoshf (complex float z)
{
return clogf (z + csqrtf (z-1.0f) * csqrtf (z+1.0f));
}
#endif
#if !defined(HAVE_CACOSH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
#define HAVE_CACOSH 1
complex double
cacosh (complex double z)
{
return clog (z + csqrt (z-1.0) * csqrt (z+1.0));
}
#endif
#if !defined(HAVE_CACOSHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
#define HAVE_CACOSHL 1
complex long double
cacoshl (complex long double z)
{
return clogl (z + csqrtl (z-1.0L) * csqrtl (z+1.0L));
}
#endif
/* Complex ATANH. Returns wrongly NaN for infinite arguments.
Algorithm taken from Abramowitz & Stegun. */
#if !defined(HAVE_CATANHF) && defined(HAVE_CLOGF)
#define HAVE_CATANHF 1
complex float
catanhf (complex float z)
{
return clogf ((1.0f+z)/(1.0f-z))/2.0f;
}
#endif
#if !defined(HAVE_CATANH) && defined(HAVE_CLOG)
#define HAVE_CATANH 1
complex double
catanh (complex double z)
{
return clog ((1.0+z)/(1.0-z))/2.0;
}
#endif
#if !defined(HAVE_CATANHL) && defined(HAVE_CLOGL)
#define HAVE_CATANHL 1
complex long double
catanhl (complex long double z)
{
return clogl ((1.0L+z)/(1.0L-z))/2.0L;
}
#endif
#if !defined(HAVE_TGAMMA)
#define HAVE_TGAMMA 1