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.



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

4 files changed, 187 insertions, 72 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 189dba0ea35..363889f7195 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 a918ddf7d23..0b2d1b8c8db 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 34783b4a5e0..2e6908f705b 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 c619f14be1e..fa8a32a2431 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");