static bool
do_mpc_ckconv (real_value *result_real, real_value *result_imag,
mpc_srcptr m, bool inexact, const real_format *format)
{
/* Proceed iff we get a normal number, i.e. not NaN or Inf and no
overflow/underflow occurred. If -frounding-math, proceed iff the
result of calling FUNC was exact. */
if (!mpfr_number_p (mpc_realref (m))
|| !mpfr_number_p (mpc_imagref (m))
|| mpfr_overflow_p ()
|| mpfr_underflow_p ()
|| (flag_rounding_math && inexact))
return false;
REAL_VALUE_TYPE tmp_real, tmp_imag;
real_from_mpfr (&tmp_real, mpc_realref (m), format, GMP_RNDN);
real_from_mpfr (&tmp_imag, mpc_imagref (m), format, GMP_RNDN);
/* Proceed iff GCC's REAL_VALUE_TYPE can hold the MPFR values.
If the REAL_VALUE_TYPE is zero but the mpft_t is not, then we
underflowed in the conversion. */
if (!real_isfinite (&tmp_real)
|| !real_isfinite (&tmp_imag)
|| (tmp_real.cl == rvc_zero) != (mpfr_zero_p (mpc_realref (m)) != 0)
|| (tmp_imag.cl == rvc_zero) != (mpfr_zero_p (mpc_imagref (m)) != 0))
return false;
real_convert (result_real, format, &tmp_real);
real_convert (result_imag, format, &tmp_imag);
return (real_identical (result_real, &tmp_real)
&& real_identical (result_imag, &tmp_imag));
}
tree
gfc_conv_mpfr_to_tree (mpfr_t f, int kind, int is_snan)
{
tree type;
int n;
REAL_VALUE_TYPE real;
n = gfc_validate_kind (BT_REAL, kind, false);
gcc_assert (gfc_real_kinds[n].radix == 2);
type = gfc_get_real_type (kind);
if (mpfr_nan_p (f) && is_snan)
real_from_string (&real, "SNaN");
else
real_from_mpfr (&real, f, type, GFC_RND_MODE);
return build_real (type, real);
}
