OSDN Git Service

2009-07-25 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 25 Jul 2009 19:39:07 +0000 (19:39 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 25 Jul 2009 19:39:07 +0000 (19:39 +0000)
            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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150087 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/intrinsic.c
gcc/fortran/intrinsic.texi
gcc/fortran/simplify.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/c99_protos.h
libgfortran/intrinsics/c99_functions.c

index 189dba0..363889f 100644 (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
index a918ddf..0b2d1b8 100644 (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,
index 34783b4..2e6908f 100644 (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
index c619f14..fa8a32a 100644 (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,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");
 
index 9651ed2..c013628 100644 (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.
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90
new file mode 100644 (file)
index 0000000..15706b9
--- /dev/null
@@ -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 (file)
index 0000000..5cde928
--- /dev/null
@@ -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 (file)
index 0000000..7e6bfbe
--- /dev/null
@@ -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" } }
index 12db117..7ba9023 100644 (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
index c35816d..73a22c3 100644 (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
index 63af2a5..3c40c1f 100644 (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