diff options
author | Tobias Burnus <burnus@net-b.de> | 2009-07-25 21:39:07 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2009-07-25 21:39:07 +0200 |
commit | 504ed63a1a4f3f35a5fc774f547e4849f53dc2b4 (patch) | |
tree | 5341f696cb6bb6fec17a250253324c998d5734db | |
parent | 86631ea3dd78a0077a6f96061affe89d5e38220f (diff) | |
download | gcc-504ed63a1a4f3f35a5fc774f547e4849f53dc2b4.zip gcc-504ed63a1a4f3f35a5fc774f547e4849f53dc2b4.tar.gz gcc-504ed63a1a4f3f35a5fc774f547e4849f53dc2b4.tar.bz2 |
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
-rw-r--r-- | gcc/fortran/ChangeLog | 14 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 12 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.texi | 51 | ||||
-rw-r--r-- | gcc/fortran/simplify.c | 182 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 | 221 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 | 41 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 | 45 | ||||
-rw-r--r-- | libgfortran/ChangeLog | 8 | ||||
-rw-r--r-- | libgfortran/c99_protos.h | 109 | ||||
-rw-r--r-- | libgfortran/intrinsics/c99_functions.c | 197 |
11 files changed, 814 insertions, 72 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 189dba0..363889f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index a918ddf..0b2d1b8 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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, diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 34783b4..2e6908f 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -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 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c619f14..fa8a32a 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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,16 +767,24 @@ 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; - } - - result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + 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; + } - mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE); + 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"); + } 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,17 +1108,25 @@ 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; - } - - result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + 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; + } - mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE); + 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"); + } 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"); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9651ed2..c013628 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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. diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 new file mode 100644 index 0000000..15706b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 new file mode 100644 index 0000000..5cde928 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 new file mode 100644 index 0000000..7e6bfbe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 @@ -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" } } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 12db117..7ba9023 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -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 diff --git a/libgfortran/c99_protos.h b/libgfortran/c99_protos.h index c35816d..73a22c3 100644 --- a/libgfortran/c99_protos.h +++ b/libgfortran/c99_protos.h @@ -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 diff --git a/libgfortran/intrinsics/c99_functions.c b/libgfortran/intrinsics/c99_functions.c index 63af2a5..3c40c1f 100644 --- a/libgfortran/intrinsics/c99_functions.c +++ b/libgfortran/intrinsics/c99_functions.c @@ -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 |