SeedValue seed_mpfr_rint_trunc (SeedContext ctx, SeedObject function, SeedObject this_object, gsize argument_count, const SeedValue args[], SeedException *exception) { mpfr_rnd_t rnd; mpfr_ptr rop, op; gint ret; CHECK_ARG_COUNT("mpfr.rint_trunc", 2); rop = seed_object_get_private(this_object); rnd = seed_value_to_mpfr_rnd_t(ctx, args[1], exception); if ( seed_value_is_object_of_class(ctx, args[0], mpfr_class) ) { op = seed_object_get_private(args[0]); } else { TYPE_EXCEPTION("mpfr.rint_trunc", "mpfr_t"); } ret = mpfr_rint_trunc(rop, op, rnd); return seed_value_from_int(ctx, ret, exception); }
/* Set iop to the integral part of op and fop to its fractional part */ int mpfr_modf (mpfr_ptr iop, mpfr_ptr fop, mpfr_srcptr op, mpfr_rnd_t rnd_mode) { mpfr_exp_t ope; mpfr_prec_t opq; int inexi, inexf; MPFR_LOG_FUNC (("op[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (op), mpfr_log_prec, op, rnd_mode), ("iop[%Pu]=%.*Rg fop[%Pu]=%.*Rg", mpfr_get_prec (iop), mpfr_log_prec, iop, mpfr_get_prec (fop), mpfr_log_prec, fop)); MPFR_ASSERTN (iop != fop); if ( MPFR_UNLIKELY (MPFR_IS_SINGULAR (op)) ) { if (MPFR_IS_NAN (op)) { MPFR_SET_NAN (iop); MPFR_SET_NAN (fop); MPFR_RET_NAN; } MPFR_SET_SAME_SIGN (iop, op); MPFR_SET_SAME_SIGN (fop, op); if (MPFR_IS_INF (op)) { MPFR_SET_INF (iop); MPFR_SET_ZERO (fop); MPFR_RET (0); } else /* op is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (op)); MPFR_SET_ZERO (iop); MPFR_SET_ZERO (fop); MPFR_RET (0); } } ope = MPFR_GET_EXP (op); opq = MPFR_PREC (op); if (ope <= 0) /* 0 < |op| < 1 */ { inexf = (fop != op) ? mpfr_set (fop, op, rnd_mode) : 0; MPFR_SET_SAME_SIGN (iop, op); MPFR_SET_ZERO (iop); MPFR_RET (INEX(0, inexf)); } else if (ope >= opq) /* op has no fractional part */ { inexi = (iop != op) ? mpfr_set (iop, op, rnd_mode) : 0; MPFR_SET_SAME_SIGN (fop, op); MPFR_SET_ZERO (fop); MPFR_RET (INEX(inexi, 0)); } else /* op has both integral and fractional parts */ { if (iop != op) { inexi = mpfr_rint_trunc (iop, op, rnd_mode); inexf = mpfr_frac (fop, op, rnd_mode); } else { MPFR_ASSERTN (fop != op); inexf = mpfr_frac (fop, op, rnd_mode); inexi = mpfr_rint_trunc (iop, op, rnd_mode); } MPFR_RET (INEX(inexi, inexf)); } }
int main (int argc, char *argv[]) { mp_size_t s; mpz_t z; mpfr_prec_t p; mpfr_t x, y, t, u, v; int r; int inexact, sign_t; tests_start_mpfr (); mpfr_init (x); mpfr_init (y); mpz_init (z); mpfr_init (t); mpfr_init (u); mpfr_init (v); mpz_set_ui (z, 1); for (s = 2; s < 100; s++) { /* z has exactly s bits */ mpz_mul_2exp (z, z, 1); if (randlimb () % 2) mpz_add_ui (z, z, 1); mpfr_set_prec (x, s); mpfr_set_prec (t, s); mpfr_set_prec (u, s); if (mpfr_set_z (x, z, MPFR_RNDN)) { printf ("Error: mpfr_set_z should be exact (s = %u)\n", (unsigned int) s); exit (1); } if (randlimb () % 2) mpfr_neg (x, x, MPFR_RNDN); if (randlimb () % 2) mpfr_div_2ui (x, x, randlimb () % s, MPFR_RNDN); for (p = 2; p < 100; p++) { int trint; mpfr_set_prec (y, p); mpfr_set_prec (v, p); for (r = 0; r < MPFR_RND_MAX ; r++) for (trint = 0; trint < 3; trint++) { if (trint == 2) inexact = mpfr_rint (y, x, (mpfr_rnd_t) r); else if (r == MPFR_RNDN) inexact = mpfr_round (y, x); else if (r == MPFR_RNDZ) inexact = (trint ? mpfr_trunc (y, x) : mpfr_rint_trunc (y, x, MPFR_RNDZ)); else if (r == MPFR_RNDU) inexact = (trint ? mpfr_ceil (y, x) : mpfr_rint_ceil (y, x, MPFR_RNDU)); else /* r = MPFR_RNDD */ inexact = (trint ? mpfr_floor (y, x) : mpfr_rint_floor (y, x, MPFR_RNDD)); if (mpfr_sub (t, y, x, MPFR_RNDN)) err ("subtraction 1 should be exact", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); sign_t = mpfr_cmp_ui (t, 0); if (trint != 0 && (((inexact == 0) && (sign_t != 0)) || ((inexact < 0) && (sign_t >= 0)) || ((inexact > 0) && (sign_t <= 0)))) err ("wrong inexact flag", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); if (inexact == 0) continue; /* end of the test for exact results */ if (((r == MPFR_RNDD || (r == MPFR_RNDZ && MPFR_SIGN (x) > 0)) && inexact > 0) || ((r == MPFR_RNDU || (r == MPFR_RNDZ && MPFR_SIGN (x) < 0)) && inexact < 0)) err ("wrong rounding direction", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); if (inexact < 0) { mpfr_add_ui (v, y, 1, MPFR_RNDU); if (mpfr_cmp (v, x) <= 0) err ("representable integer between x and its " "rounded value", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); } else { mpfr_sub_ui (v, y, 1, MPFR_RNDD); if (mpfr_cmp (v, x) >= 0) err ("representable integer between x and its " "rounded value", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); } if (r == MPFR_RNDN) { int cmp; if (mpfr_sub (u, v, x, MPFR_RNDN)) err ("subtraction 2 should be exact", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); cmp = mpfr_cmp_abs (t, u); if (cmp > 0) err ("faithful rounding, but not the nearest integer", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); if (cmp < 0) continue; /* |t| = |u|: x is the middle of two consecutive representable integers. */ if (trint == 2) { /* halfway case for mpfr_rint in MPFR_RNDN rounding mode: round to an even integer or significand. */ mpfr_div_2ui (y, y, 1, MPFR_RNDZ); if (!mpfr_integer_p (y)) err ("halfway case for mpfr_rint, result isn't an" " even integer", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); /* If floor(x) and ceil(x) aren't both representable integers, the significand must be even. */ mpfr_sub (v, v, y, MPFR_RNDN); mpfr_abs (v, v, MPFR_RNDN); if (mpfr_cmp_ui (v, 1) != 0) { mpfr_div_2si (y, y, MPFR_EXP (y) - MPFR_PREC (y) + 1, MPFR_RNDN); if (!mpfr_integer_p (y)) err ("halfway case for mpfr_rint, significand isn't" " even", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); } } else { /* halfway case for mpfr_round: x must have been rounded away from zero. */ if ((MPFR_SIGN (x) > 0 && inexact < 0) || (MPFR_SIGN (x) < 0 && inexact > 0)) err ("halfway case for mpfr_round, bad rounding" " direction", s, x, y, p, (mpfr_rnd_t) r, trint, inexact); } } } } } mpfr_clear (x); mpfr_clear (y); mpz_clear (z); mpfr_clear (t); mpfr_clear (u); mpfr_clear (v); special (); coverage_03032011 (); #if __MPFR_STDC (199901L) if (argc > 1 && strcmp (argv[1], "-s") == 0) test_against_libc (); #endif tests_end_mpfr (); return 0; }