Commit 8e70c271 by Kaveh R. Ghazi Committed by Kaveh Ghazi

re PR fortran/33197 (Fortran 2008: math functions)

	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.

From-SVN: r152394
parent 9a801c38
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> 2009-10-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41515 PR fortran/41515
......
...@@ -1616,6 +1616,9 @@ gfc_intrinsic_sym; ...@@ -1616,6 +1616,9 @@ gfc_intrinsic_sym;
# if MPC_VERSION >= MPC_VERSION_NUM(0,6,1) # if MPC_VERSION >= MPC_VERSION_NUM(0,6,1)
# define HAVE_mpc_pow # define HAVE_mpc_pow
# endif # endif
# if MPC_VERSION >= MPC_VERSION_NUM(0,7,1)
# define HAVE_mpc_arc
# endif
#else #else
#define mpc_realref(X) ((X).r) #define mpc_realref(X) ((X).r)
#define mpc_imagref(X) ((X).i) #define mpc_imagref(X) ((X).i)
......
...@@ -745,16 +745,21 @@ gfc_simplify_acos (gfc_expr *x) ...@@ -745,16 +745,21 @@ gfc_simplify_acos (gfc_expr *x)
&x->where); &x->where);
return &gfc_bad_expr; 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; break;
case BT_COMPLEX: 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: default:
gfc_internal_error ("in gfc_simplify_acos(): Bad type"); 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) ...@@ -781,7 +786,13 @@ gfc_simplify_acosh (gfc_expr *x)
mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE); mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
break; break;
case BT_COMPLEX: 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: default:
gfc_internal_error ("in gfc_simplify_acosh(): Bad type"); gfc_internal_error ("in gfc_simplify_acosh(): Bad type");
} }
...@@ -1043,7 +1054,13 @@ gfc_simplify_asin (gfc_expr *x) ...@@ -1043,7 +1054,13 @@ gfc_simplify_asin (gfc_expr *x)
mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE); mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
break; break;
case BT_COMPLEX: 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: default:
gfc_internal_error ("in gfc_simplify_asin(): Bad type"); gfc_internal_error ("in gfc_simplify_asin(): Bad type");
} }
...@@ -1067,7 +1084,13 @@ gfc_simplify_asinh (gfc_expr *x) ...@@ -1067,7 +1084,13 @@ gfc_simplify_asinh (gfc_expr *x)
mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE); mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
break; break;
case BT_COMPLEX: 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: default:
gfc_internal_error ("in gfc_simplify_asinh(): Bad type"); gfc_internal_error ("in gfc_simplify_asinh(): Bad type");
} }
...@@ -1091,7 +1114,13 @@ gfc_simplify_atan (gfc_expr *x) ...@@ -1091,7 +1114,13 @@ gfc_simplify_atan (gfc_expr *x)
mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE); mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
break; break;
case BT_COMPLEX: 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: default:
gfc_internal_error ("in gfc_simplify_atan(): Bad type"); gfc_internal_error ("in gfc_simplify_atan(): Bad type");
} }
...@@ -1123,7 +1152,13 @@ gfc_simplify_atanh (gfc_expr *x) ...@@ -1123,7 +1152,13 @@ gfc_simplify_atanh (gfc_expr *x)
mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE); mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
break; break;
case BT_COMPLEX: 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: default:
gfc_internal_error ("in gfc_simplify_atanh(): Bad type"); gfc_internal_error ("in gfc_simplify_atanh(): Bad type");
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment