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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 06e1ae5..55386ac 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2009-10-01  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.
+

 2009-10-01  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/41515
 2009-10-01  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/41515

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 326112d..b40f01b 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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,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)
 #else
 #define mpc_realref(X) ((X).r)
 #define mpc_imagref(X) ((X).i)

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a22dd00..9856b2e 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -745,16 +745,21 @@ gfc_simplify_acos (gfc_expr *x)
                       &x->where);
            return &gfc_bad_expr;
          }
                       &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:
        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;
        return NULL;

+#endif

       default:
        gfc_internal_error ("in gfc_simplify_acos(): Bad type");
     }
 
       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");
 }
 
   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:
        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;
        return NULL;

+#endif

       default:
        gfc_internal_error ("in gfc_simplify_acosh(): Bad type");
     }
       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:
        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;
        return NULL;

+#endif

       default:
        gfc_internal_error ("in gfc_simplify_asin(): Bad type");
     }
       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:
        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;
        return NULL;

+#endif

       default:
        gfc_internal_error ("in gfc_simplify_asinh(): Bad type");
     }
       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:
        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;
        return NULL;

+#endif

       default:
        gfc_internal_error ("in gfc_simplify_atan(): Bad type");
     }
       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:
        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;
        return NULL;

+#endif

       default:
        gfc_internal_error ("in gfc_simplify_atanh(): Bad type");
     }
       default:
        gfc_internal_error ("in gfc_simplify_atanh(): Bad type");
     }