[PATCH]: PR fortran/33197, use MPC for complex "arc" functions

[Kaveh R. GHAZI]

Support for the "arc" functions has been added to the MPC repository and
will be in the forthcoming mpc-0.8 release.  This patch to GCC adds
complex "arc" support to the fortran frontend using MPC.

Since it's about 11:55 pm Sept 30th in Hawaii, I'm hoping to swoop in
under the permissive stage1 deadline noted here. :-)
http://gcc.gnu.org/ml/gcc/2009-09/msg00659.html

Some guidance for a testcase would be appreciated.

Bootstrapped --enable-languages=c,fortran on x86_64-unknown-linux-gnu
both without MPC and with MPC svn revision 689.  No regressions.

Okay for mainline?

		Thanks,
		--Kaveh


2009-09-30  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>

	PR fortran/33197
	* gfortran.h (HAVE_mpc_arc): Define.
	* simplify.c (gfc_simplify_acos): Handle complex acos.
	(gfc_simplify_acosh): Likewise for acosh.
	(gfc_simplify_asin): Likewise for asin.
	(gfc_simplify_asinh): Likewise for asinh.
	(gfc_simplify_atan): Likewise for atan.
	(gfc_simplify_atanh): Likewise for atanh.

diff -rup orig/egcc-SVN20091001/gcc/fortran/gfortran.h egcc-SVN20091001/gcc/fortran/gfortran.h
--- orig/egcc-SVN20091001/gcc/fortran/gfortran.h	2009-10-01 02:02:38.000000000 +0200
+++ egcc-SVN20091001/gcc/fortran/gfortran.h	2009-10-01 05:39:48.000000000 +0200
@@ -1616,6 +1616,9 @@ gfc_intrinsic_sym;
 # if MPC_VERSION >= MPC_VERSION_NUM(0,6,1)
 #  define HAVE_mpc_pow
 # endif
+# if MPC_VERSION >= MPC_VERSION_NUM(0,7,1)
+#  define HAVE_mpc_arc
+# endif
 #else
 #define mpc_realref(X) ((X).r)
 #define mpc_imagref(X) ((X).i)
diff -rup orig/egcc-SVN20091001/gcc/fortran/simplify.c egcc-SVN20091001/gcc/fortran/simplify.c
--- orig/egcc-SVN20091001/gcc/fortran/simplify.c	2009-09-26 02:01:16.000000000 +0200
+++ egcc-SVN20091001/gcc/fortran/simplify.c	2009-10-01 05:48:09.000000000 +0200
@@ -745,16 +745,21 @@ gfc_simplify_acos (gfc_expr *x)
 		       &x->where);
 	    return &gfc_bad_expr;
 	  }
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpfr_acos (result->value.real, x->value.real, GFC_RND_MODE);
 	break;
       case BT_COMPLEX:
+#ifdef HAVE_mpc_arc
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpc_acos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+#else
 	return NULL;
+#endif
       default:
 	gfc_internal_error ("in gfc_simplify_acos(): Bad type");
     }

-  result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
-
-  mpfr_acos (result->value.real, x->value.real, GFC_RND_MODE);

   return range_check (result, "ACOS");
 }
@@ -781,7 +786,13 @@ gfc_simplify_acosh (gfc_expr *x)
 	mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
 	break;
       case BT_COMPLEX:
+#ifdef HAVE_mpc_arc
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpc_acosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+#else
 	return NULL;
+#endif
       default:
 	gfc_internal_error ("in gfc_simplify_acosh(): Bad type");
     }
@@ -1043,7 +1054,13 @@ gfc_simplify_asin (gfc_expr *x)
 	mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
 	break;
       case BT_COMPLEX:
+#ifdef HAVE_mpc_arc
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpc_asin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+#else
 	return NULL;
+#endif
       default:
 	gfc_internal_error ("in gfc_simplify_asin(): Bad type");
     }
@@ -1067,7 +1084,13 @@ gfc_simplify_asinh (gfc_expr *x)
 	mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
 	break;
       case BT_COMPLEX:
+#ifdef HAVE_mpc_arc
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpc_asinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+#else
 	return NULL;
+#endif
       default:
 	gfc_internal_error ("in gfc_simplify_asinh(): Bad type");
     }
@@ -1091,7 +1114,13 @@ gfc_simplify_atan (gfc_expr *x)
 	mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
 	break;
       case BT_COMPLEX:
+#ifdef HAVE_mpc_arc
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpc_atan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+#else
 	return NULL;
+#endif
       default:
 	gfc_internal_error ("in gfc_simplify_atan(): Bad type");
     }
@@ -1123,7 +1152,13 @@ gfc_simplify_atanh (gfc_expr *x)
 	mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
 	break;
       case BT_COMPLEX:
+#ifdef HAVE_mpc_arc
+	result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+	mpc_atanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+#else
 	return NULL;
+#endif
       default:
 	gfc_internal_error ("in gfc_simplify_atanh(): Bad type");
     }