static void
check_large (void)
{
mpfr_t x, y, z;
mpfr_init2 (x, 20000);
mpfr_init2 (y, 21000);
mpfr_init2 (z, 11791);
/* The algo failed to round for p=11791. */
(mpfr_const_pi) (z, GMP_RNDU);
mpfr_const_pi (x, GMP_RNDN); /* First one ! */
mpfr_const_pi (y, GMP_RNDN); /* Then the other - cache - */
mpfr_prec_round (y, 20000, GMP_RNDN);
if (mpfr_cmp (x, y)) {
printf ("const_pi: error for large prec (%d)\n", 1);
exit (1);
}
mpfr_prec_round (y, 11791, GMP_RNDU);
if (mpfr_cmp (z, y)) {
printf ("const_pi: error for large prec (%d)\n", 2);
exit (1);
}
/* a worst-case to exercise recomputation */
if (MPFR_PREC_MAX > 33440) {
mpfr_set_prec (x, 33440);
mpfr_const_pi (x, GMP_RNDZ);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
/* This bug occurs in mpfr_exp_2 on a Linux-64 machine, r5475. */
static void
bug20080731 (void)
{
mpfr_exp_t emin;
mpfr_t x, y1, y2;
mpfr_prec_t prec = 64;
emin = mpfr_get_emin ();
set_emin (MPFR_EMIN_MIN);
mpfr_init2 (x, 200);
mpfr_set_str (x, "-2.c5c85fdf473de6af278ece700fcbdabd03cd0cb9ca62d8b62c@7",
16, MPFR_RNDN);
mpfr_init2 (y1, prec);
mpfr_exp (y1, x, MPFR_RNDU);
/* Compute the result with a higher internal precision. */
mpfr_init2 (y2, 300);
mpfr_exp (y2, x, MPFR_RNDU);
mpfr_prec_round (y2, prec, MPFR_RNDU);
if (mpfr_cmp0 (y1, y2) != 0)
{
printf ("Error in bug20080731\nExpected ");
mpfr_out_str (stdout, 16, 0, y2, MPFR_RNDN);
printf ("\nGot ");
mpfr_out_str (stdout, 16, 0, y1, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_clears (x, y1, y2, (mpfr_ptr) 0);
set_emin (emin);
}
static PyObject *
GMPy_Real_Round2(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *result, *tempx;
long n = 0;
CHECK_CONTEXT(context);
if (y) {
n = PyIntOrLong_AsLong(y);
if ( (n == -1 && PyErr_Occurred()) || n < MPFR_PREC_MIN || n > MPFR_PREC_MAX) {
VALUE_ERROR("invalid precision");
return NULL;
}
}
if (!(tempx = GMPy_MPFR_From_Real(x, 1, context))) {
return NULL;
}
if (!(result = GMPy_MPFR_New(mpfr_get_prec(tempx->f), context))) {
Py_DECREF((PyObject*)tempx);
return NULL;
}
mpfr_set(result->f, tempx->f, GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempx);
mpfr_clear_flags();
result->rc = mpfr_prec_round(result->f, n, GET_MPFR_ROUND(context));
_GMPy_MPFR_Cleanup(&result, context);
return (PyObject*)result;
}
/* compute remainder as in definition:
r = x - n * y, where n = trunc(x/y).
warning: may change flags. */
static int
slow_fmod (mpfr_ptr r, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd)
{
mpfr_t q;
int inexact;
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x)
|| MPFR_IS_ZERO (y))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
else /* either y is Inf and x is 0 or non-special,
or x is 0 and y is non-special,
in both cases the quotient is zero. */
return mpfr_set (r, x, rnd);
}
/* regular cases */
/* if 2^(ex-1) <= |x| < 2^ex, and 2^(ey-1) <= |y| < 2^ey,
then |x/y| < 2^(ex-ey+1) */
mpfr_init2 (q,
MAX (MPFR_PREC_MIN, mpfr_get_exp (x) - mpfr_get_exp (y) + 1));
mpfr_div (q, x, y, MPFR_RNDZ);
mpfr_trunc (q, q); /* may change inexact flag */
mpfr_prec_round (q, mpfr_get_prec (q) + mpfr_get_prec (y), MPFR_RNDZ);
inexact = mpfr_mul (q, q, y, MPFR_RNDZ); /* exact */
inexact = mpfr_sub (r, x, q, rnd);
mpfr_clear (q);
return inexact;
}
/* s <- 1 - r/2! + r^2/4! + ... + (-1)^l r^l/(2l)! + ...
Assumes |r| < 1.
Returns the index l0 of the last term (-1)^l r^l/(2l)!.
The absolute error on s is at most 2 * l0 * 2^(-m).
*/
static int
mpfr_cos2_aux (mpfr_ptr s, mpfr_srcptr r)
{
unsigned int l, b = 2;
long int prec, m = MPFR_PREC(s);
mpfr_t t;
MPFR_ASSERTD (MPFR_GET_EXP (r) <= 0);
mpfr_init2 (t, m);
MPFR_SET_ONE (t);
mpfr_set (s, t, GMP_RNDN);
for (l = 1; MPFR_GET_EXP (t) + m >= 0; l++)
{
mpfr_mul (t, t, r, GMP_RNDU); /* err <= (3l-1) ulp */
mpfr_div_ui (t, t, (2*l-1)*(2*l), GMP_RNDU); /* err <= 3l ulp */
if (l % 2 == 0)
mpfr_add (s, s, t, GMP_RNDD);
else
mpfr_sub (s, s, t, GMP_RNDD);
MPFR_ASSERTD (MPFR_GET_EXP (s) == 0); /* check 1/2 <= s < 1 */
/* err(s) <= l * 2^(-m) */
if (MPFR_UNLIKELY(3 * l > (1U << b)))
b++;
/* now 3l <= 2^b, we want 3l*ulp(t) <= 2^(-m)
i.e. b+EXP(t)-PREC(t) <= -m */
prec = m + MPFR_GET_EXP (t) + b;
if (MPFR_LIKELY(prec >= MPFR_PREC_MIN))
mpfr_prec_round (t, prec, GMP_RNDN);
}
mpfr_clear (t);
return l;
}
static void
check_large (void)
{
mpfr_t x, y, z;
mpfr_init2 (x, 25000);
mpfr_init2 (y, 26000);
mpfr_init2 (z, 26000);
(mpfr_const_log2) (x, MPFR_RNDN); /* First one ! */
(mpfr_const_log2) (y, MPFR_RNDN); /* Then the other - cache - */
mpfr_set (z, y, MPFR_RNDN);
mpfr_prec_round (y, 25000, MPFR_RNDN);
if (mpfr_cmp (x, y) != 0)
{
printf ("const_log2: error for large prec\n");
printf ("x = ");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
printf ("y = ");
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\n");
printf ("z = ");
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
/* worst-case with 15 successive ones after last bit,
to exercise can_round loop */
mpfr_set_prec (x, 26249);
mpfr_const_log2 (x, MPFR_RNDZ);
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
static void *
start_routine (void *arg)
{
mpfr_prec_t p;
mpfr_t x;
mpfr_prec_t inc = *(int *) arg;
mp_limb_t *m;
for (p = 100; p < 20000; p += 64 + 100 * (inc % 10))
{
mpfr_init2 (x, p);
m = MPFR_MANT (x);
mpfr_const_pi (x, MPFR_RNDD);
mpfr_prec_round (x, 53, MPFR_RNDD);
if (mpfr_cmp_str1 (x, "3.141592653589793116"))
{
printf ("mpfr_const_pi failed with threading\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
/* Check that no reallocation has been performed */
MPFR_ASSERTN (m == MPFR_MANT (x));
mpfr_clear (x);
}
pthread_exit (NULL);
}
static void
consistency (void)
{
mpfr_t x, y, z1, z2;
int i;
mpfr_inits (x, y, z1, z2, (mpfr_ptr) 0);
for (i = 0; i < 10000; i++)
{
mpfr_rnd_t rnd;
mpfr_prec_t px, py, pz, p;
int inex1, inex2;
rnd = RND_RAND ();
px = (randlimb () % 256) + 2;
py = (randlimb () % 128) + 2;
pz = (randlimb () % 256) + 2;
mpfr_set_prec (x, px);
mpfr_set_prec (y, py);
mpfr_set_prec (z1, pz);
mpfr_set_prec (z2, pz);
mpfr_urandomb (x, RANDS);
do
mpfr_urandomb (y, RANDS);
while (mpfr_zero_p (y));
inex1 = mpfr_div (z1, x, y, rnd);
MPFR_ASSERTN (!MPFR_IS_NAN (z1));
p = MAX (MAX (px, py), pz);
if (mpfr_prec_round (x, p, MPFR_RNDN) != 0 ||
mpfr_prec_round (y, p, MPFR_RNDN) != 0)
{
printf ("mpfr_prec_round error for i = %d\n", i);
exit (1);
}
inex2 = mpfr_div (z2, x, y, rnd);
MPFR_ASSERTN (!MPFR_IS_NAN (z2));
if (inex1 != inex2 || mpfr_cmp (z1, z2) != 0)
{
printf ("Consistency error for i = %d\n", i);
exit (1);
}
}
mpfr_clears (x, y, z1, z2, (mpfr_ptr) 0);
}
static decimal r_round_prec(const decimal& a,int p)
{
#ifdef USE_CGAL
CGAL::Gmpfr m=to_gmpfr(a);
mpfr_prec_round(m.fr(),p,MPFR_RNDN);
return decimal(m);
#else
return a;//TODO
#endif
}
/* Bug in mpfr_divhigh_n_basecase when all limbs of q (except the most
significant one) are B-1 where B=2^GMP_NUMB_BITS. Since we truncate
the divisor at each step, it might happen at some point that
(np[n-1],np[n-2]) > (d1,d0), and not only the equality.
Reported by Ricky Farr
<https://sympa.inria.fr/sympa/arc/mpfr/2015-10/msg00023.html>
To get a failure, a MPFR_DIVHIGH_TAB entry below the MPFR_DIV_THRESHOLD
limit must have a value 0. With most mparam.h files, this cannot occur. To
make the bug appear, one can configure MPFR with -DMPFR_TUNE_COVERAGE. */
static void
test_20151023 (void)
{
mpfr_prec_t p;
mpfr_t n, d, q, q0;
int inex, i;
for (p = GMP_NUMB_BITS; p <= 2000; p++)
{
mpfr_init2 (n, 2*p);
mpfr_init2 (d, p);
mpfr_init2 (q, p);
mpfr_init2 (q0, GMP_NUMB_BITS);
/* generate a random divisor of p bits */
mpfr_urandomb (d, RANDS);
/* generate a random quotient of GMP_NUMB_BITS bits */
mpfr_urandomb (q0, RANDS);
/* zero-pad the quotient to p bits */
inex = mpfr_prec_round (q0, p, MPFR_RNDN);
MPFR_ASSERTN(inex == 0);
for (i = 0; i < 3; i++)
{
/* i=0: try with the original quotient xxx000...000
i=1: try with the original quotient minus one ulp
i=2: try with the original quotient plus one ulp */
if (i == 1)
mpfr_nextbelow (q0);
else if (i == 2)
{
mpfr_nextabove (q0);
mpfr_nextabove (q0);
}
inex = mpfr_mul (n, d, q0, MPFR_RNDN);
MPFR_ASSERTN(inex == 0);
mpfr_nextabove (n);
mpfr_div (q, n, d, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp (q, q0) == 0);
inex = mpfr_mul (n, d, q0, MPFR_RNDN);
MPFR_ASSERTN(inex == 0);
mpfr_nextbelow (n);
mpfr_div (q, n, d, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp (q, q0) == 0);
}
mpfr_clear (n);
mpfr_clear (d);
mpfr_clear (q);
mpfr_clear (q0);
}
}
/** round to (binary) bits, not (decimal) digits
*/
int my_mpfr_round (mpfr_t R, long prec, mpfr_t X, mpfr_rnd_t RND)
{
int ans;
if(prec < MPFR_PREC_MIN)
error("prec = %d < %d is too small", prec, MPFR_PREC_MIN);
if(prec > MPFR_PREC_MAX)
error("prec = %d > %d is too large", prec, MPFR_PREC_MAX);
mpfr_set(R, X, RND);
ans = mpfr_prec_round(R, (mpfr_prec_t) prec, RND);
return ans;
}
/* special code for IEEE 754 little-endian extended format */
long double
mpfr_get_ld (mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_long_double_t ld;
mpfr_t tmp;
int inex;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_LDBL_MANT_DIG);
inex = mpfr_set (tmp, x, rnd_mode);
mpfr_set_emin (-16382-63);
mpfr_set_emax (16384);
mpfr_subnormalize (tmp, mpfr_check_range (tmp, inex, rnd_mode), rnd_mode);
mpfr_prec_round (tmp, 64, MPFR_RNDZ); /* exact */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (tmp)))
ld.ld = (long double) mpfr_get_d (tmp, rnd_mode);
else
{
mp_limb_t *tmpmant;
mpfr_exp_t e, denorm;
tmpmant = MPFR_MANT (tmp);
e = MPFR_GET_EXP (tmp);
/* The smallest positive normal number is 2^(-16382), which is
0.5*2^(-16381) in MPFR, thus any exponent <= -16382 corresponds to a
subnormal number. The smallest positive subnormal number is 2^(-16445)
which is 0.5*2^(-16444) in MPFR thus 0 <= denorm <= 63. */
denorm = MPFR_UNLIKELY (e <= -16382) ? - e - 16382 + 1 : 0;
MPFR_ASSERTD (0 <= denorm && denorm < 64);
#if GMP_NUMB_BITS >= 64
ld.s.manl = (tmpmant[0] >> denorm);
ld.s.manh = (tmpmant[0] >> denorm) >> 32;
#elif GMP_NUMB_BITS == 32
if (MPFR_LIKELY (denorm == 0))
{
ld.s.manl = tmpmant[0];
ld.s.manh = tmpmant[1];
}
else if (denorm < 32)
{
ld.s.manl = (tmpmant[0] >> denorm) | (tmpmant[1] << (32 - denorm));
ld.s.manh = tmpmant[1] >> denorm;
}
else /* 32 <= denorm < 64 */
{
long double
mpfr_get_ld (mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_long_double_t ld;
mpfr_t tmp;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_set_emin (-16382-63);
mpfr_set_emax (16383);
mpfr_init2 (tmp, MPFR_LDBL_MANT_DIG);
mpfr_subnormalize(tmp, mpfr_set (tmp, x, rnd_mode), rnd_mode);
mpfr_prec_round (tmp, 64, GMP_RNDZ); /* exact */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (tmp)))
ld.ld = (long double) mpfr_get_d (tmp, rnd_mode);
else
{
mp_limb_t *tmpmant;
mp_exp_t e, denorm;
tmpmant = MPFR_MANT (tmp);
e = MPFR_GET_EXP (tmp);
denorm = MPFR_UNLIKELY (e < -16382) ? - e - 16382 + 1 : 0;
#if BITS_PER_MP_LIMB >= 64
ld.s.manl = (tmpmant[0] >> denorm);
ld.s.manh = (tmpmant[0] >> denorm) >> 32;
#elif BITS_PER_MP_LIMB == 32
if (MPFR_LIKELY (denorm == 0))
{
ld.s.manl = tmpmant[0];
ld.s.manh = tmpmant[1];
}
else if (denorm < 32)
{
ld.s.manl = (tmpmant[0] >> denorm) | (tmpmant[1] << (32 - denorm));
ld.s.manh = tmpmant[1] >> denorm;
}
else /* 32 <= denorm <= 64 */
{
/* TODO: A test with more inputs (but can't be compared to mpfr_add). */
static void
check_extreme (void)
{
mpfr_t u, v, w, x, y;
mpfr_ptr t[2];
int i, inex1, inex2, r;
t[0] = u;
t[1] = v;
mpfr_inits2 (32, u, v, w, x, y, (mpfr_ptr) 0);
mpfr_setmin (u, mpfr_get_emax ());
mpfr_setmax (v, mpfr_get_emin ());
mpfr_setmin (w, mpfr_get_emax () - 40);
RND_LOOP (r)
for (i = 0; i < 2; i++)
{
mpfr_set_prec (x, 64);
inex1 = mpfr_add (x, u, w, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
inex1 = mpfr_prec_round (x, 32, (mpfr_rnd_t) r);
inex2 = mpfr_sum (y, t, 2, (mpfr_rnd_t) r);
if (!(mpfr_equal_p (x, y) && SAME_SIGN (inex1, inex2)))
{
printf ("Error in check_extreme (%s, i = %d)\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
printf ("Expected ");
mpfr_dump (x);
printf ("with inex = %d\n", inex1);
printf ("Got ");
mpfr_dump (y);
printf ("with inex = %d\n", inex2);
exit (1);
}
mpfr_neg (v, v, MPFR_RNDN);
mpfr_neg (w, w, MPFR_RNDN);
}
mpfr_clears (u, v, w, x, y, (mpfr_ptr) 0);
}
SeedValue seed_mpfr_prec_round (SeedContext ctx,
SeedObject function,
SeedObject this_object,
gsize argument_count,
const SeedValue args[],
SeedException *exception)
{
mpfr_rnd_t rnd;
mp_prec_t prec;
mpfr_ptr rop;
gint ret;
CHECK_ARG_COUNT("mpfr.prec_round", 2);
rop = seed_object_get_private(this_object);
prec = seed_value_to_mpfr_prec_t(ctx, args[0], exception);
rnd = seed_value_to_mpfr_rnd_t(ctx, args[1], exception);
ret = mpfr_prec_round(rop, prec, rnd);
return seed_value_from_int(ctx, ret, exception);
}
static void
check_large (void)
{
mpfr_t x, y;
mpfr_init2 (x, 25000);
mpfr_init2 (y, 26000);
mpfr_const_log2 (x, GMP_RNDN); /* First one ! */
mpfr_const_log2 (y, GMP_RNDN); /* Then the other - cache - */
mpfr_prec_round (y, 25000, GMP_RNDN);
if (mpfr_cmp (x, y))
{
printf ("const_pi: error for large prec\n");
exit (1);
}
/* worst-case with 15 successive ones after last bit,
to exercise can_round loop */
mpfr_set_prec (x, 26249);
mpfr_const_log2 (x, GMP_RNDZ);
mpfr_clears (x, y, NULL);
}
/* Test n random bad cases. A precision py in [pymin,pymax] and
* a number y of precision py are chosen randomly. One computes
* x = inv(y) in precision px = py + psup (rounded to nearest).
* Then (in general), y is a bad case for fct in precision py (in
* the directed rounding modes, but also in the rounding-to-nearest
* mode for some lower precision: see data_check).
* fct, inv, name: data related to the function.
* pos, emin, emax: arguments for tests_default_random.
*/
void
bad_cases (int (*fct)(FLIST), int (*inv)(FLIST), const char *name,
int pos, mpfr_exp_t emin, mpfr_exp_t emax,
mpfr_prec_t pymin, mpfr_prec_t pymax, mpfr_prec_t psup,
int n)
{
mpfr_t x, y, z;
char *dbgenv;
int i, dbg;
mpfr_exp_t old_emin, old_emax;
old_emin = mpfr_get_emin ();
old_emax = mpfr_get_emax ();
dbgenv = getenv ("MPFR_DEBUG_BADCASES");
dbg = dbgenv != 0 ? atoi (dbgenv) : 0; /* debug level */
mpfr_inits (x, y, z, (mpfr_ptr) 0);
for (i = 0; i < n; i++)
{
mpfr_prec_t px, py, pz;
int inex;
if (dbg)
printf ("bad_cases: i = %d\n", i);
py = pymin + (randlimb () % (pymax - pymin + 1));
mpfr_set_prec (y, py);
tests_default_random (y, pos, emin, emax);
if (dbg)
{
printf ("bad_cases: yprec =%4ld, y = ", (long) py);
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\n");
}
px = py + psup;
mpfr_set_prec (x, px);
mpfr_clear_flags ();
inv (x, y, MPFR_RNDN);
if (mpfr_nanflag_p () || mpfr_overflow_p () || mpfr_underflow_p ())
{
if (dbg)
printf ("bad_cases: no normal inverse\n");
goto next_i;
}
if (dbg > 1)
{
printf ("bad_cases: x = ");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
}
pz = px;
do
{
pz += 32;
mpfr_set_prec (z, pz);
if (fct (z, x, MPFR_RNDN) == 0)
{
if (dbg)
printf ("bad_cases: exact case\n");
goto next_i;
}
if (dbg)
{
if (dbg > 1)
{
printf ("bad_cases: %s(x) ~= ", name);
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
}
else
{
printf ("bad_cases: [MPFR_RNDZ] ~= ");
mpfr_out_str (stdout, 16, 40, z, MPFR_RNDZ);
}
printf ("\n");
}
inex = mpfr_prec_round (z, py, MPFR_RNDN);
if (mpfr_nanflag_p () || mpfr_overflow_p () || mpfr_underflow_p ()
|| ! mpfr_equal_p (z, y))
{
if (dbg)
printf ("bad_cases: inverse doesn't match\n");
goto next_i;
}
}
while (inex == 0);
/* We really have a bad case. */
do
py--;
while (py >= MPFR_PREC_MIN && mpfr_prec_round (z, py, MPFR_RNDZ) == 0);
py++;
/* py is now the smallest output precision such that we have
a bad case in the directed rounding modes. */
if (mpfr_prec_round (y, py, MPFR_RNDZ) != 0)
{
printf ("Internal error for i = %d\n", i);
exit (1);
}
if ((inex > 0 && MPFR_IS_POS (z)) ||
(inex < 0 && MPFR_IS_NEG (z)))
{
mpfr_nexttozero (y);
if (mpfr_zero_p (y))
goto next_i;
}
if (dbg)
{
printf ("bad_cases: yprec =%4ld, y = ", (long) py);
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\n");
}
/* Note: y is now the expected result rounded toward zero. */
test5rm (fct, x, y, z, MPFR_RNDZ, 0, name);
next_i:
/* In case the exponent range has been changed by
tests_default_random()... */
mpfr_set_emin (old_emin);
mpfr_set_emax (old_emax);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
/* The test_one argument is seen a boolean. If it is true and rnd is
a rounding mode toward infinity, then the function is tested in
only one rounding mode (the one provided in rnd) and the variable
rndnext is not used (due to the break). If it is true and rnd is a
rounding mode toward or away from zero, then the function is tested
twice, first with the provided rounding mode and second with the
rounding mode toward the corresponding infinity (determined by the
sign of the result). If it is false, then the function is tested
in the 5 rounding modes, and rnd must initially be MPFR_RNDZ; thus
rndnext will be initialized in the first iteration.
If the test_one argument is 2, then this means that y is exact, and
the ternary value is checked.
As examples of use, see the calls to test5rm from the data_check and
bad_cases functions. */
static void
test5rm (int (*fct) (FLIST), mpfr_srcptr x, mpfr_ptr y, mpfr_ptr z,
mpfr_rnd_t rnd, int test_one, const char *name)
{
mpfr_prec_t yprec = MPFR_PREC (y);
mpfr_rnd_t rndnext = MPFR_RND_MAX; /* means uninitialized */
MPFR_ASSERTN (test_one || rnd == MPFR_RNDZ);
mpfr_set_prec (z, yprec);
while (1)
{
int inex;
MPFR_ASSERTN (rnd != MPFR_RND_MAX);
inex = fct (z, x, rnd);
if (! (mpfr_equal_p (y, z) || (mpfr_nan_p (y) && mpfr_nan_p (z))))
{
printf ("Error for %s with xprec=%lu, yprec=%lu, rnd=%s\nx = ",
name, (unsigned long) MPFR_PREC (x), (unsigned long) yprec,
mpfr_print_rnd_mode (rnd));
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\nexpected ");
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\ngot ");
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (test_one == 2 && inex != 0)
{
printf ("Error for %s with xprec=%lu, yprec=%lu, rnd=%s\nx = ",
name, (unsigned long) MPFR_PREC (x), (unsigned long) yprec,
mpfr_print_rnd_mode (rnd));
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\nexact case, but non-zero ternary value (%d)\n", inex);
exit (1);
}
if (rnd == MPFR_RNDN)
break;
if (test_one)
{
if (rnd == MPFR_RNDU || rnd == MPFR_RNDD)
break;
if (MPFR_IS_NEG (y))
rnd = (rnd == MPFR_RNDA) ? MPFR_RNDD : MPFR_RNDU;
else
rnd = (rnd == MPFR_RNDA) ? MPFR_RNDU : MPFR_RNDD;
}
else if (rnd == MPFR_RNDZ)
{
rnd = MPFR_IS_NEG (y) ? MPFR_RNDU : MPFR_RNDD;
rndnext = MPFR_RNDA;
}
else
{
rnd = rndnext;
if (rnd == MPFR_RNDA)
{
mpfr_nexttoinf (y);
rndnext = (MPFR_IS_NEG (y)) ? MPFR_RNDD : MPFR_RNDU;
}
else if (rndnext != MPFR_RNDN)
rndnext = MPFR_RNDN;
else
{
if (yprec == MPFR_PREC_MIN)
break;
mpfr_prec_round (y, --yprec, MPFR_RNDZ);
mpfr_set_prec (z, yprec);
}
}
}
}
static void
check_1minuseps (void)
{
static mpfr_prec_t prec_a[] = {
MPFR_PREC_MIN, 30, 31, 32, 33, 62, 63, 64, 65, 126, 127, 128, 129
};
static int supp_b[] = {
0, 1, 2, 3, 4, 29, 30, 31, 32, 33, 34, 35, 61, 62, 63, 64, 65, 66, 67
};
mpfr_t a, b, c;
unsigned int ia, ib, ic;
mpfr_init2 (c, MPFR_PREC_MIN);
for (ia = 0; ia < numberof (prec_a); ia++)
for (ib = 0; ib < numberof(supp_b); ib++)
{
mpfr_prec_t prec_b;
int rnd_mode;
prec_b = prec_a[ia] + supp_b[ib];
mpfr_init2 (a, prec_a[ia]);
mpfr_init2 (b, prec_b);
mpfr_set_ui (c, 1, MPFR_RNDN);
mpfr_div_ui (b, c, prec_a[ia], MPFR_RNDN);
mpfr_sub (b, c, b, MPFR_RNDN); /* b = 1 - 2^(-prec_a) */
for (ic = 0; ic < numberof(supp_b); ic++)
for (rnd_mode = 0; rnd_mode < MPFR_RND_MAX; rnd_mode++)
{
mpfr_t s;
int inex_a, inex_s;
mpfr_set_ui (c, 1, MPFR_RNDN);
mpfr_div_ui (c, c, prec_a[ia] + supp_b[ic], MPFR_RNDN);
inex_a = test_add (a, b, c, (mpfr_rnd_t) rnd_mode);
mpfr_init2 (s, 256);
inex_s = test_add (s, b, c, MPFR_RNDN); /* exact */
if (inex_s)
{
printf ("check_1minuseps: result should have been exact "
"(ia = %u, ib = %u, ic = %u)\n", ia, ib, ic);
exit (1);
}
inex_s = mpfr_prec_round (s, prec_a[ia], (mpfr_rnd_t) rnd_mode);
if ((inex_a < 0 && inex_s >= 0) ||
(inex_a == 0 && inex_s != 0) ||
(inex_a > 0 && inex_s <= 0) ||
!mpfr_equal_p (a, s))
{
printf ("check_1minuseps: results are different.\n");
printf ("ia = %u, ib = %u, ic = %u\n", ia, ib, ic);
exit (1);
}
mpfr_clear (s);
}
mpfr_clear (a);
mpfr_clear (b);
}
mpfr_clear (c);
}
static void
check_1111 (void)
{
mpfr_t one;
long n;
mpfr_init2 (one, MPFR_PREC_MIN);
mpfr_set_ui (one, 1, MPFR_RNDN);
for (n = 0; n < NUM; n++)
{
mpfr_prec_t prec_a, prec_b, prec_c;
mpfr_exp_t tb=0, tc, diff;
mpfr_t a, b, c, s;
int m = 512;
int sb, sc;
int inex_a, inex_s;
mpfr_rnd_t rnd_mode;
prec_a = MPFR_PREC_MIN + (randlimb () % m);
prec_b = MPFR_PREC_MIN + (randlimb () % m);
prec_c = MPFR_PREC_MIN + (randlimb () % m);
mpfr_init2 (a, prec_a);
mpfr_init2 (b, prec_b);
mpfr_init2 (c, prec_c);
sb = randlimb () % 3;
if (sb != 0)
{
tb = 1 + (randlimb () % (prec_b - (sb != 2)));
mpfr_div_2ui (b, one, tb, MPFR_RNDN);
if (sb == 2)
mpfr_neg (b, b, MPFR_RNDN);
test_add (b, b, one, MPFR_RNDN);
}
else
mpfr_set (b, one, MPFR_RNDN);
tc = 1 + (randlimb () % (prec_c - 1));
mpfr_div_2ui (c, one, tc, MPFR_RNDN);
sc = randlimb () % 2;
if (sc)
mpfr_neg (c, c, MPFR_RNDN);
test_add (c, c, one, MPFR_RNDN);
diff = (randlimb () % (2*m)) - m;
mpfr_mul_2si (c, c, diff, MPFR_RNDN);
rnd_mode = RND_RAND ();
inex_a = test_add (a, b, c, rnd_mode);
mpfr_init2 (s, MPFR_PREC_MIN + 2*m);
inex_s = test_add (s, b, c, MPFR_RNDN); /* exact */
if (inex_s)
{
printf ("check_1111: result should have been exact.\n");
exit (1);
}
inex_s = mpfr_prec_round (s, prec_a, rnd_mode);
if ((inex_a < 0 && inex_s >= 0) ||
(inex_a == 0 && inex_s != 0) ||
(inex_a > 0 && inex_s <= 0) ||
!mpfr_equal_p (a, s))
{
printf ("check_1111: results are different.\n");
printf ("prec_a = %d, prec_b = %d, prec_c = %d\n",
(int) prec_a, (int) prec_b, (int) prec_c);
printf ("tb = %d, tc = %d, diff = %d, rnd = %s\n",
(int) tb, (int) tc, (int) diff,
mpfr_print_rnd_mode (rnd_mode));
printf ("sb = %d, sc = %d\n", sb, sc);
printf ("a = ");
mpfr_print_binary (a);
puts ("");
printf ("s = ");
mpfr_print_binary (s);
puts ("");
printf ("inex_a = %d, inex_s = %d\n", inex_a, inex_s);
exit (1);
}
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
mpfr_clear (s);
}
mpfr_clear (one);
}
static void
test_generic (mpfr_prec_t p0, mpfr_prec_t p1, unsigned int nmax)
{
mpfr_prec_t prec, xprec, yprec;
mpfr_t x, y, z, t, w;
#if defined(TWO_ARGS_ALL)
mpfr_t u;
#endif
#if defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
double d;
#endif
#if defined(ULONG_ARG1) || defined(ULONG_ARG2)
unsigned long i;
#endif
mpfr_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n;
unsigned long ctrt = 0, ctrn = 0;
int test_of = 1, test_uf = 1;
mpfr_exp_t old_emin, old_emax;
old_emin = mpfr_get_emin ();
old_emax = mpfr_get_emax ();
mpfr_inits2 (MPFR_PREC_MIN, x, y, z, t, w, (mpfr_ptr) 0);
#if defined(TWO_ARGS_ALL)
mpfr_init2 (u, MPFR_PREC_MIN);
#endif
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
mpfr_set_prec (w, yprec);
/* Note: in precision p1, we test 4 special cases. */
for (n = 0; n < (prec == p1 ? nmax + 4 : nmax); n++)
{
int infinite_input = 0;
unsigned int flags;
mpfr_exp_t oemin, oemax;
xprec = prec;
if (randlimb () & 1)
{
xprec *= (double) randlimb () / MP_LIMB_T_MAX;
if (xprec < MPFR_PREC_MIN)
xprec = MPFR_PREC_MIN;
}
mpfr_set_prec (x, xprec);
#if defined(TWO_ARGS)
mpfr_set_prec (u, xprec);
#elif defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_set_prec (u, IEEE_DBL_MANT_DIG);
#elif defined(ULONG_ARG1) || defined(ULONG_ARG2)
mpfr_set_prec (u, sizeof (unsigned long) * CHAR_BIT);
#endif
if (n > 3 || prec < p1)
{
#if defined(RAND_FUNCTION)
RAND_FUNCTION (x);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
RAND_FUNCTION (u);
#endif
#else /* ! defined(RAND_FUNCTION) */
tests_default_random (x, TEST_RANDOM_POS,
TEST_RANDOM_EMIN, TEST_RANDOM_EMAX,
TEST_RANDOM_ALWAYS_SCALE);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
tests_default_random (u, TEST_RANDOM_POS2,
TEST_RANDOM_EMIN, TEST_RANDOM_EMAX,
TEST_RANDOM_ALWAYS_SCALE);
#endif
#endif /* ! defined(RAND_FUNCTION) */
}
else
{
/* Special cases tested in precision p1 if n <= 3. They are
useful really in the extended exponent range. */
#if (defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)) && defined(MPFR_ERRDIVZERO)
goto next_n;
#endif
set_emin (MPFR_EMIN_MIN);
set_emax (MPFR_EMAX_MAX);
if (n <= 1)
{
mpfr_set_si (x, n == 0 ? 1 : -1, MPFR_RNDN);
mpfr_set_exp (x, mpfr_get_emin ());
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_set_si (u, randlimb () % 2 == 0 ? 1 : -1, MPFR_RNDN);
mpfr_set_exp (u, mpfr_get_emin ());
#endif
}
else /* 2 <= n <= 3 */
{
if (getenv ("MPFR_CHECK_MAX") == NULL)
goto next_n;
mpfr_set_si (x, n == 0 ? 1 : -1, MPFR_RNDN);
mpfr_setmax (x, REDUCE_EMAX);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_set_si (u, randlimb () % 2 == 0 ? 1 : -1, MPFR_RNDN);
mpfr_setmax (u, mpfr_get_emax ());
#endif
}
}
#if defined(ULONG_ARG1) || defined(ULONG_ARG2)
i = randlimb ();
inexact = mpfr_set_ui (u, i, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
#endif
/* Exponent range for the test. */
oemin = mpfr_get_emin ();
oemax = mpfr_get_emax ();
rnd = RND_RAND ();
mpfr_clear_flags ();
#ifdef DEBUG_TGENERIC
TGENERIC_INFO (TEST_FUNCTION, MPFR_PREC (y));
#endif
#if defined(TWO_ARGS)
compare = TEST_FUNCTION (y, x, u, rnd);
#elif defined(DOUBLE_ARG1)
d = mpfr_get_d (u, rnd);
compare = TEST_FUNCTION (y, d, x, rnd);
/* d can be infinite due to overflow in mpfr_get_d */
infinite_input |= DOUBLE_ISINF (d);
#elif defined(DOUBLE_ARG2)
d = mpfr_get_d (u, rnd);
compare = TEST_FUNCTION (y, x, d, rnd);
/* d can be infinite due to overflow in mpfr_get_d */
infinite_input |= DOUBLE_ISINF (d);
#elif defined(ULONG_ARG1)
compare = TEST_FUNCTION (y, i, x, rnd);
#elif defined(ULONG_ARG2)
compare = TEST_FUNCTION (y, x, i, rnd);
#else
compare = TEST_FUNCTION (y, x, rnd);
#endif
flags = __gmpfr_flags;
if (mpfr_get_emin () != oemin ||
mpfr_get_emax () != oemax)
{
printf ("tgeneric: the exponent range has been modified"
" by the tested function!\n");
exit (1);
}
TGENERIC_CHECK ("bad inexact flag",
(compare != 0) ^ (mpfr_inexflag_p () == 0));
ctrt++;
/* Tests in a reduced exponent range. */
{
unsigned int oldflags = flags;
mpfr_exp_t e, emin, emax;
/* Determine the smallest exponent range containing the
exponents of the mpfr_t inputs (x, and u if TWO_ARGS)
and output (y). */
emin = MPFR_EMAX_MAX;
emax = MPFR_EMIN_MIN;
if (MPFR_IS_PURE_FP (x))
{
e = MPFR_GET_EXP (x);
if (e < emin)
emin = e;
if (e > emax)
emax = e;
}
#if defined(TWO_ARGS)
if (MPFR_IS_PURE_FP (u))
{
e = MPFR_GET_EXP (u);
if (e < emin)
emin = e;
if (e > emax)
emax = e;
}
#endif
if (MPFR_IS_PURE_FP (y))
{
e = MPFR_GET_EXP (y);
if (test_of && e - 1 >= emax)
{
unsigned int ex_flags;
mpfr_set_emax (e - 1);
mpfr_clear_flags ();
#if defined(TWO_ARGS)
inexact = TEST_FUNCTION (w, x, u, rnd);
#elif defined(DOUBLE_ARG1)
inexact = TEST_FUNCTION (w, d, x, rnd);
#elif defined(DOUBLE_ARG2)
inexact = TEST_FUNCTION (w, x, d, rnd);
#elif defined(ULONG_ARG1)
inexact = TEST_FUNCTION (w, i, x, rnd);
#elif defined(ULONG_ARG2)
inexact = TEST_FUNCTION (w, x, i, rnd);
#else
inexact = TEST_FUNCTION (w, x, rnd);
#endif
flags = __gmpfr_flags;
mpfr_set_emax (oemax);
ex_flags = MPFR_FLAGS_OVERFLOW | MPFR_FLAGS_INEXACT;
if (flags != ex_flags)
{
printf ("tgeneric: error for " MAKE_STR(TEST_FUNCTION)
", reduced exponent range [%"
MPFR_EXP_FSPEC "d,%" MPFR_EXP_FSPEC
"d] (overflow test) on:\n",
(mpfr_eexp_t) oemin, (mpfr_eexp_t) e - 1);
printf ("x = ");
mpfr_dump (x);
#if defined(TWO_ARGS_ALL)
printf ("u = ");
mpfr_dump (u);
#endif
printf ("yprec = %u, rnd_mode = %s\n",
(unsigned int) yprec,
mpfr_print_rnd_mode (rnd));
printf ("Expected flags =");
flags_out (ex_flags);
printf (" got flags =");
flags_out (flags);
printf ("inex = %d, w = ", inexact);
mpfr_dump (w);
exit (1);
}
test_of = 0; /* Overflow is tested only once. */
}
if (test_uf && e + 1 <= emin)
{
unsigned int ex_flags;
mpfr_set_emin (e + 1);
mpfr_clear_flags ();
#if defined(TWO_ARGS)
inexact = TEST_FUNCTION (w, x, u, rnd);
#elif defined(DOUBLE_ARG1)
inexact = TEST_FUNCTION (w, d, x, rnd);
#elif defined(DOUBLE_ARG2)
inexact = TEST_FUNCTION (w, x, d, rnd);
#elif defined(ULONG_ARG1)
inexact = TEST_FUNCTION (w, i, x, rnd);
#elif defined(ULONG_ARG2)
inexact = TEST_FUNCTION (w, x, i, rnd);
#else
inexact = TEST_FUNCTION (w, x, rnd);
#endif
flags = __gmpfr_flags;
mpfr_set_emin (oemin);
ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT;
if (flags != ex_flags)
{
printf ("tgeneric: error for " MAKE_STR(TEST_FUNCTION)
", reduced exponent range [%"
MPFR_EXP_FSPEC "d,%" MPFR_EXP_FSPEC
"d] (underflow test) on:\n",
(mpfr_eexp_t) e + 1, (mpfr_eexp_t) oemax);
printf ("x = ");
mpfr_dump (x);
#if defined(TWO_ARGS_ALL)
printf ("u = ");
mpfr_dump (u);
#endif
printf ("yprec = %u, rnd_mode = %s\n",
(unsigned int) yprec,
mpfr_print_rnd_mode (rnd));
printf ("Expected flags =");
flags_out (ex_flags);
printf (" got flags =");
flags_out (flags);
printf ("inex = %d, w = ", inexact);
mpfr_dump (w);
exit (1);
}
test_uf = 0; /* Underflow is tested only once. */
}
if (e < emin)
emin = e;
if (e > emax)
emax = e;
}
if (emin > emax)
emin = emax; /* case where all values are singular */
/* Consistency test in a reduced exponent range. Doing it
for the first 10 samples and for prec == p1 (which has
some special cases) should be sufficient. */
if (ctrt <= 10 || prec == p1)
{
mpfr_set_emin (emin);
mpfr_set_emax (emax);
#ifdef DEBUG_TGENERIC
/* Useful information in case of assertion failure. */
printf ("tgeneric: reduced exponent range [%"
MPFR_EXP_FSPEC "d,%" MPFR_EXP_FSPEC "d]\n",
(mpfr_eexp_t) emin, (mpfr_eexp_t) emax);
#endif
mpfr_clear_flags ();
#if defined(TWO_ARGS)
inexact = TEST_FUNCTION (w, x, u, rnd);
#elif defined(DOUBLE_ARG1)
inexact = TEST_FUNCTION (w, d, x, rnd);
#elif defined(DOUBLE_ARG2)
inexact = TEST_FUNCTION (w, x, d, rnd);
#elif defined(ULONG_ARG1)
inexact = TEST_FUNCTION (w, i, x, rnd);
#elif defined(ULONG_ARG2)
inexact = TEST_FUNCTION (w, x, i, rnd);
#else
inexact = TEST_FUNCTION (w, x, rnd);
#endif
flags = __gmpfr_flags;
mpfr_set_emin (oemin);
mpfr_set_emax (oemax);
if (! (SAME_VAL (w, y) &&
SAME_SIGN (inexact, compare) &&
flags == oldflags))
{
printf ("tgeneric: error for " MAKE_STR(TEST_FUNCTION)
", reduced exponent range [%"
MPFR_EXP_FSPEC "d,%" MPFR_EXP_FSPEC "d] on:\n",
(mpfr_eexp_t) emin, (mpfr_eexp_t) emax);
printf ("x = ");
mpfr_dump (x);
#if defined(TWO_ARGS_ALL)
printf ("u = ");
mpfr_dump (u);
#endif
printf ("yprec = %u, rnd_mode = %s\n",
(unsigned int) yprec, mpfr_print_rnd_mode (rnd));
printf ("Expected:\n y = ");
mpfr_dump (y);
printf (" inex = %d, flags =", compare);
flags_out (oldflags);
printf ("Got:\n w = ");
mpfr_dump (w);
printf (" inex = %d, flags =", inexact);
flags_out (flags);
exit (1);
}
}
__gmpfr_flags = oldflags; /* restore the flags */
}
if (MPFR_IS_SINGULAR (y))
{
if (MPFR_IS_NAN (y) || mpfr_nanflag_p ())
TGENERIC_CHECK ("bad NaN flag",
MPFR_IS_NAN (y) && mpfr_nanflag_p ());
else if (MPFR_IS_INF (y))
{
TGENERIC_CHECK ("bad overflow flag",
(compare != 0) ^ (mpfr_overflow_p () == 0));
TGENERIC_CHECK ("bad divide-by-zero flag",
(compare == 0 && !infinite_input) ^
(mpfr_divby0_p () == 0));
}
else if (MPFR_IS_ZERO (y))
TGENERIC_CHECK ("bad underflow flag",
(compare != 0) ^ (mpfr_underflow_p () == 0));
}
else if (mpfr_divby0_p ())
{
TGENERIC_CHECK ("both overflow and divide-by-zero",
! mpfr_overflow_p ());
TGENERIC_CHECK ("both underflow and divide-by-zero",
! mpfr_underflow_p ());
TGENERIC_CHECK ("bad compare value (divide-by-zero)",
compare == 0);
}
else if (mpfr_overflow_p ())
{
TGENERIC_CHECK ("both underflow and overflow",
! mpfr_underflow_p ());
TGENERIC_CHECK ("bad compare value (overflow)", compare != 0);
mpfr_nexttoinf (y);
TGENERIC_CHECK ("should have been max MPFR number (overflow)",
MPFR_IS_INF (y));
}
else if (mpfr_underflow_p ())
{
TGENERIC_CHECK ("bad compare value (underflow)", compare != 0);
mpfr_nexttozero (y);
TGENERIC_CHECK ("should have been min MPFR number (underflow)",
MPFR_IS_ZERO (y));
}
else if (mpfr_can_round (y, yprec, rnd, rnd, prec))
{
ctrn++;
mpfr_set (t, y, rnd);
/* Risk of failures are known when some flags are already set
before the function call. Do not set the erange flag, as
it will remain set after the function call and no checks
are performed in such a case (see the mpfr_erangeflag_p
test below). */
if (randlimb () & 1)
__gmpfr_flags = MPFR_FLAGS_ALL ^ MPFR_FLAGS_ERANGE;
#ifdef DEBUG_TGENERIC
TGENERIC_INFO (TEST_FUNCTION, MPFR_PREC (z));
#endif
/* Let's increase the precision of the inputs in a random way.
In most cases, this doesn't make any difference, but for
the mpfr_fmod bug fixed in r6230, this triggers the bug. */
mpfr_prec_round (x, mpfr_get_prec (x) + (randlimb () & 15),
MPFR_RNDN);
#if defined(TWO_ARGS)
mpfr_prec_round (u, mpfr_get_prec (u) + (randlimb () & 15),
MPFR_RNDN);
inexact = TEST_FUNCTION (z, x, u, rnd);
#elif defined(DOUBLE_ARG1)
inexact = TEST_FUNCTION (z, d, x, rnd);
#elif defined(DOUBLE_ARG2)
inexact = TEST_FUNCTION (z, x, d, rnd);
#elif defined(ULONG_ARG1)
inexact = TEST_FUNCTION (z, i, x, rnd);
#elif defined(ULONG_ARG2)
inexact = TEST_FUNCTION (z, x, i, rnd);
#else
inexact = TEST_FUNCTION (z, x, rnd);
#endif
if (mpfr_erangeflag_p ())
goto next_n;
if (! mpfr_equal_p (t, z))
{
printf ("tgeneric: results differ for "
MAKE_STR(TEST_FUNCTION) " on\n x = ");
mpfr_dump (x);
#if defined(TWO_ARGS_ALL)
printf (" u = ");
mpfr_dump (u);
#endif
printf (" prec = %u, rnd_mode = %s\n",
(unsigned int) prec, mpfr_print_rnd_mode (rnd));
printf ("Got ");
mpfr_dump (z);
printf ("Expected ");
mpfr_dump (t);
printf ("Approx ");
mpfr_dump (y);
exit (1);
}
compare2 = mpfr_cmp (t, y);
/* if rounding to nearest, cannot know the sign of t - f(x)
because of composed rounding: y = o(f(x)) and t = o(y) */
if (compare * compare2 >= 0)
compare = compare + compare2;
else
compare = inexact; /* cannot determine sign(t-f(x)) */
if (! SAME_SIGN (inexact, compare))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d"
"\n", mpfr_print_rnd_mode (rnd), compare, inexact);
printf ("x = ");
mpfr_dump (x);
#if defined(TWO_ARGS_ALL)
printf ("u = ");
mpfr_dump (u);
#endif
printf ("y = ");
mpfr_dump (y);
printf ("t = ");
mpfr_dump (t);
exit (1);
}
}
else if (getenv ("MPFR_SUSPICIOUS_OVERFLOW") != NULL)
{
/* For developers only! */
MPFR_ASSERTN (MPFR_IS_PURE_FP (y));
mpfr_nexttoinf (y);
if (MPFR_IS_INF (y) && MPFR_IS_LIKE_RNDZ (rnd, MPFR_IS_NEG (y))
&& !mpfr_overflow_p () && TGENERIC_SO_TEST)
{
printf ("Possible bug! |y| is the maximum finite number "
"and has been obtained when\nrounding toward zero"
" (%s). Thus there is a very probable overflow,\n"
"but the overflow flag is not set!\n",
mpfr_print_rnd_mode (rnd));
printf ("x = ");
mpfr_dump (x);
#if defined(TWO_ARGS_ALL)
printf ("u = ");
mpfr_dump (u);
#endif
exit (1);
}
}
next_n:
/* In case the exponent range has been changed by
tests_default_random() or for special values... */
mpfr_set_emin (old_emin);
mpfr_set_emax (old_emax);
}
}
#ifndef TGENERIC_NOWARNING
if (3 * ctrn < 2 * ctrt)
printf ("Warning! Too few normal cases in generic tests (%lu / %lu)\n",
ctrn, ctrt);
#endif
mpfr_clears (x, y, z, t, w, (mpfr_ptr) 0);
#if defined(TWO_ARGS_ALL)
mpfr_clear (u);
#endif
}
int
mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
int inex;
unsigned long absn;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex));
absn = SAFE_ABS (unsigned long, n);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z)))
{
if (MPFR_IS_NAN (z))
{
MPFR_SET_NAN (res); /* y(n,NaN) = NaN */
MPFR_RET_NAN;
}
/* y(n,z) tends to zero when z goes to +Inf, oscillating around
0. We choose to return +0 in that case. */
else if (MPFR_IS_INF (z))
{
if (MPFR_SIGN(z) > 0)
return mpfr_set_ui (res, 0, r);
else /* y(n,-Inf) = NaN */
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
}
else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise,
when z goes to zero */
{
MPFR_SET_INF(res);
if (n >= 0 || ((unsigned long) n & 1) == 0)
MPFR_SET_NEG(res);
else
MPFR_SET_POS(res);
mpfr_set_divby0 ();
MPFR_RET(0);
}
}
/* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we
assume does not happen for a rational z. */
if (MPFR_SIGN(z) < 0)
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
/* now z is not singular, and z > 0 */
MPFR_SAVE_EXPO_MARK (expo);
/* Deal with tiny arguments. We have:
y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more
precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z),
g(z) - 0.41*z^2 < y0(z)/log(z) < g(z)
thus since log(z) is negative:
g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z)
and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on
y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2.
Note: we use both the main term in log(z) and the constant term, because
otherwise the relative error would be only in 1/log(|log(z)|).
*/
if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2))
{
mpfr_t l, h, t, logz;
mpfr_prec_t prec;
int ok, inex2;
prec = MPFR_PREC(res) + 10;
mpfr_init2 (l, prec);
mpfr_init2 (h, prec);
mpfr_init2 (t, prec);
mpfr_init2 (logz, prec);
/* first enclose log(z) + euler - log(2) = log(z/2) + euler */
mpfr_log (logz, z, MPFR_RNDD); /* lower bound of log(z) */
mpfr_set (h, logz, MPFR_RNDU); /* exact */
mpfr_nextabove (h); /* upper bound of log(z) */
mpfr_const_euler (t, MPFR_RNDD); /* lower bound of euler */
mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */
mpfr_nextabove (t); /* upper bound of euler */
mpfr_add (h, h, t, MPFR_RNDU); /* upper bound of log(z) + euler */
mpfr_const_log2 (t, MPFR_RNDU); /* upper bound of log(2) */
mpfr_sub (l, l, t, MPFR_RNDD); /* lower bound of log(z/2) + euler */
mpfr_nextbelow (t); /* lower bound of log(2) */
mpfr_sub (h, h, t, MPFR_RNDU); /* upper bound of log(z/2) + euler */
mpfr_const_pi (t, MPFR_RNDU); /* upper bound of Pi */
mpfr_div (l, l, t, MPFR_RNDD); /* lower bound of (log(z/2)+euler)/Pi */
mpfr_nextbelow (t); /* lower bound of Pi */
mpfr_div (h, h, t, MPFR_RNDD); /* upper bound of (log(z/2)+euler)/Pi */
mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */
mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */
/* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z)
to h */
mpfr_mul (t, z, z, MPFR_RNDU); /* upper bound on z^2 */
/* since logz is negative, a lower bound corresponds to an upper bound
for its absolute value */
mpfr_neg (t, t, MPFR_RNDD);
mpfr_div_2ui (t, t, 1, MPFR_RNDD);
mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */
mpfr_add (h, h, t, MPFR_RNDU);
inex = mpfr_prec_round (l, MPFR_PREC(res), r);
inex2 = mpfr_prec_round (h, MPFR_PREC(res), r);
/* we need h=l and inex=inex2 */
ok = (inex == inex2) && mpfr_equal_p (l, h);
if (ok)
mpfr_set (res, h, r); /* exact */
mpfr_clear (l);
mpfr_clear (h);
mpfr_clear (t);
mpfr_clear (logz);
if (ok)
goto end;
}
/* small argument check for y1(z) = -2/Pi/z + O(log(z)):
for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */
if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res))
{
mpfr_t y;
mpfr_prec_t prec;
mpfr_exp_t err1;
int ok;
MPFR_BLOCK_DECL (flags);
/* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1),
then |y1(z)| > 2^emax */
prec = MPFR_PREC(res) + 10;
mpfr_init2 (y, prec);
mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u
represents a quantity <= 1/2^prec */
mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */
MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ));
/* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */
if (MPFR_OVERFLOW (flags))
{
mpfr_clear (y);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (res, r, -1);
}
mpfr_neg (y, y, MPFR_RNDN);
/* (1+u)^6 can be written 1+7u [for another value of u], thus the
error on 2/Pi/z is less than 7ulp(y). The truncation error is less
than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y),
otherwise it is less than 1/4+7/8 <= 2. */
if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */
err1 = 3;
else /* ulp(y) <= 1/8 */
err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1;
ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r);
if (ok)
inex = mpfr_set (res, y, r);
mpfr_clear (y);
if (ok)
goto end;
}
/* we can use the asymptotic expansion as soon as z > p log(2)/2,
but to get some margin we use it for z > p/2 */
if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0)
{
inex = mpfr_yn_asympt (res, n, z, r);
if (inex != 0)
goto end;
}
/* General case */
{
mpfr_prec_t prec;
mpfr_exp_t err1, err2, err3;
mpfr_t y, s1, s2, s3;
MPFR_ZIV_DECL (loop);
mpfr_init (y);
mpfr_init (s1);
mpfr_init (s2);
mpfr_init (s3);
prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13;
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
mpfr_set_prec (y, prec);
mpfr_set_prec (s1, prec);
mpfr_set_prec (s2, prec);
mpfr_set_prec (s3, prec);
mpfr_mul (y, z, z, MPFR_RNDN);
mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */
/* store (z/2)^n temporarily in s2 */
mpfr_pow_ui (s2, z, absn, MPFR_RNDN);
mpfr_div_2si (s2, s2, absn, MPFR_RNDN);
/* compute S1 * (z/2)^(-n) */
if (n == 0)
{
mpfr_set_ui (s1, 0, MPFR_RNDN);
err1 = 0;
}
else
err1 = mpfr_yn_s1 (s1, y, absn - 1);
mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */
/* See algorithms.tex: the relative error on s1 is bounded by
(3n+3)*2^(e+1-prec). */
err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1;
/* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */
/* compute (z/2)^n * S3 */
mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */
err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */
/* the error on s3 is bounded by 2^err3 ulps */
/* add s1+s3 */
err1 += MPFR_EXP(s1);
mpfr_add (s1, s1, s3, MPFR_RNDN);
/* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1))
+ 2^err3*2^(EXP(s3) - EXP(s1)) */
err3 += MPFR_EXP(s3);
err1 = (err3 > err1) ? err3 + 1 : err1 + 1;
err1 -= MPFR_EXP(s1);
err1 = (err1 >= 0) ? err1 + 1 : 1;
/* now the error on s1 is bounded by 2^err1*ulp(s1) */
/* compute S2 */
mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */
mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */
mpfr_const_euler (s3, MPFR_RNDN);
err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3);
mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */
err2 -= MPFR_EXP(s2);
mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */
mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */
mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */
err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see
algorithms.tex */
/* add all three sums */
err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */
err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */
mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */
err2 = (err1 > err2) ? err1 + 1 : err2 + 1;
err2 -= MPFR_EXP(s2);
err2 = (err2 >= 0) ? err2 + 1 : 1;
/* now the error on s2 is bounded by 2^err2*ulp(s2) */
mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */
mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by
2^(err2+1)*ulp(s2) */
err2 ++;
if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r)))
break;
MPFR_ZIV_NEXT (loop, prec);
}
MPFR_ZIV_FREE (loop);
/* Assume two's complement for the test n & 1 */
inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ?
MPFR_SIGN (s2) : - MPFR_SIGN (s2));
mpfr_clear (y);
mpfr_clear (s1);
mpfr_clear (s2);
mpfr_clear (s3);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (res, inex, r);
}
/* we have x >= 1/2 here */
static int
mpfr_digamma_positive (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t p = MPFR_PREC(y) + 10, q;
mpfr_t t, u, x_plus_j;
int inex;
mpfr_exp_t errt, erru, expt;
unsigned long j = 0, min;
MPFR_ZIV_DECL (loop);
/* compute a precision q such that x+1 is exact */
if (MPFR_PREC(x) < MPFR_EXP(x))
q = MPFR_EXP(x);
else
q = MPFR_PREC(x) + 1;
mpfr_init2 (x_plus_j, q);
mpfr_init2 (t, p);
mpfr_init2 (u, p);
MPFR_ZIV_INIT (loop, p);
for(;;)
{
/* Lower bound for x+j in mpfr_digamma_approx call: since the smallest
term of the divergent series for Digamma(x) is about exp(-2*Pi*x), and
we want it to be less than 2^(-p), this gives x > p*log(2)/(2*Pi)
i.e., x >= 0.1103 p.
To be safe, we ensure x >= 0.25 * p.
*/
min = (p + 3) / 4;
if (min < 2)
min = 2;
mpfr_set (x_plus_j, x, MPFR_RNDN);
mpfr_set_ui (u, 0, MPFR_RNDN);
j = 0;
while (mpfr_cmp_ui (x_plus_j, min) < 0)
{
j ++;
mpfr_ui_div (t, 1, x_plus_j, MPFR_RNDN); /* err <= 1/2 ulp */
mpfr_add (u, u, t, MPFR_RNDN);
inex = mpfr_add_ui (x_plus_j, x_plus_j, 1, MPFR_RNDZ);
if (inex != 0) /* we lost one bit */
{
q ++;
mpfr_prec_round (x_plus_j, q, MPFR_RNDZ);
mpfr_nextabove (x_plus_j);
}
/* since all terms are positive, the error is bounded by j ulps */
}
for (erru = 0; j > 1; erru++, j = (j + 1) / 2);
errt = mpfr_digamma_approx (t, x_plus_j);
expt = MPFR_EXP(t);
mpfr_sub (t, t, u, MPFR_RNDN);
if (MPFR_EXP(t) < expt)
errt += expt - MPFR_EXP(t);
if (MPFR_EXP(t) < MPFR_EXP(u))
erru += MPFR_EXP(u) - MPFR_EXP(t);
if (errt > erru)
errt = errt + 1;
else if (errt == erru)
errt = errt + 2;
else
errt = erru + 1;
if (MPFR_CAN_ROUND (t, p - errt, MPFR_PREC(y), rnd_mode))
break;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (t, p);
mpfr_set_prec (u, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (y, t, rnd_mode);
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (x_plus_j);
return inex;
}
static void
test_generic (mp_prec_t p0, mp_prec_t p1, unsigned int N)
{
mp_prec_t prec, xprec, yprec;
mpfr_t x, y, z, t;
#ifdef TWO_ARGS
mpfr_t u;
#elif defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_t u;
double d;
#endif
mp_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n;
unsigned long ctrt = 0, ctrn = 0;
mp_exp_t old_emin, old_emax;
old_emin = mpfr_get_emin ();
old_emax = mpfr_get_emax ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_init (u);
#endif
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
/* Note: in precision p1, we test 4 special cases. */
for (n = 0; n < (prec == p1 ? N + 4 : N); n++)
{
xprec = prec;
if (randlimb () & 1)
{
xprec *= (double) randlimb () / MP_LIMB_T_MAX;
if (xprec < MPFR_PREC_MIN)
xprec = MPFR_PREC_MIN;
}
mpfr_set_prec (x, xprec);
#ifdef TWO_ARGS
mpfr_set_prec (u, xprec);
#elif defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_set_prec (u, IEEE_DBL_MANT_DIG);
#endif
if (n > 3 || prec < p1)
{
#if defined(RAND_FUNCTION)
RAND_FUNCTION (x);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
RAND_FUNCTION (u);
#endif
#else
tests_default_random (x, TEST_RANDOM_POS,
TEST_RANDOM_EMIN, TEST_RANDOM_EMAX);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
tests_default_random (u, TEST_RANDOM_POS2,
TEST_RANDOM_EMIN, TEST_RANDOM_EMAX);
#endif
#endif
}
else
{
/* Special cases tested in precision p1 if n <= 3. They are
useful really in the extended exponent range. */
set_emin (MPFR_EMIN_MIN);
set_emax (MPFR_EMAX_MAX);
if (n <= 1)
{
mpfr_set_si (x, n == 0 ? 1 : -1, GMP_RNDN);
mpfr_set_exp (x, mpfr_get_emin ());
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_set_si (u, randlimb () % 2 == 0 ? 1 : -1, GMP_RNDN);
mpfr_set_exp (u, mpfr_get_emin ());
#endif
}
else /* 2 <= n <= 3 */
{
if (getenv ("MPFR_CHECK_MAX") == NULL)
goto next_n;
mpfr_set_si (x, n == 0 ? 1 : -1, GMP_RNDN);
mpfr_setmax (x, REDUCE_EMAX);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_set_si (u, randlimb () % 2 == 0 ? 1 : -1, GMP_RNDN);
mpfr_setmax (u, mpfr_get_emax ());
#endif
}
}
rnd = RND_RAND ();
mpfr_clear_flags ();
#ifdef DEBUG_TGENERIC
TGENERIC_INFO (TEST_FUNCTION, MPFR_PREC (y));
#endif
#if defined(TWO_ARGS)
compare = TEST_FUNCTION (y, x, u, rnd);
#elif defined(DOUBLE_ARG1)
d = mpfr_get_d (u, rnd);
compare = TEST_FUNCTION (y, d, x, rnd);
#elif defined(DOUBLE_ARG2)
d = mpfr_get_d (u, rnd);
compare = TEST_FUNCTION (y, x, d, rnd);
#else
compare = TEST_FUNCTION (y, x, rnd);
#endif
TGENERIC_CHECK ("Bad inexact flag",
(compare != 0) ^ (mpfr_inexflag_p () == 0));
ctrt++;
if (MPFR_IS_SINGULAR (y))
{
if (MPFR_IS_NAN (y) || mpfr_nanflag_p ())
TGENERIC_CHECK ("Bad NaN flag",
MPFR_IS_NAN (y) && mpfr_nanflag_p ());
else if (MPFR_IS_INF (y))
TGENERIC_CHECK ("Bad overflow flag",
(compare != 0) ^ (mpfr_overflow_p () == 0));
else if (MPFR_IS_ZERO (y))
TGENERIC_CHECK ("Bad underflow flag",
(compare != 0) ^ (mpfr_underflow_p () == 0));
}
else if (mpfr_overflow_p ())
{
TGENERIC_CHECK ("Bad compare value (overflow)", compare != 0);
mpfr_nexttoinf (y);
TGENERIC_CHECK ("Should have been max MPFR number",
MPFR_IS_INF (y));
}
else if (mpfr_underflow_p ())
{
TGENERIC_CHECK ("Bad compare value (underflow)", compare != 0);
mpfr_nexttozero (y);
TGENERIC_CHECK ("Should have been min MPFR number",
MPFR_IS_ZERO (y));
}
else if (mpfr_can_round (y, yprec, rnd, rnd, prec))
{
ctrn++;
mpfr_set (t, y, rnd);
/* Risk of failures are known when some flags are already set
before the function call. Do not set the erange flag, as
it will remain set after the function call and no checks
are performed in such a case (see the mpfr_erangeflag_p
test below). */
if (randlimb () & 1)
__gmpfr_flags = MPFR_FLAGS_ALL ^ MPFR_FLAGS_ERANGE;
#ifdef DEBUG_TGENERIC
TGENERIC_INFO (TEST_FUNCTION, MPFR_PREC (z));
#endif
/* Let's increase the precision of the inputs in a random way.
In most cases, this doesn't make any difference, but this
triggers the mpfr_fmod bug fixed in r6235. */
mpfr_prec_round (x, mpfr_get_prec (x) + (randlimb () & 15),
GMP_RNDN);
#if defined(TWO_ARGS)
mpfr_prec_round (u, mpfr_get_prec (u) + (randlimb () & 15),
GMP_RNDN);
inexact = TEST_FUNCTION (z, x, u, rnd);
#elif defined(DOUBLE_ARG1)
inexact = TEST_FUNCTION (z, d, x, rnd);
#elif defined(DOUBLE_ARG2)
inexact = TEST_FUNCTION (z, x, d, rnd);
#else
inexact = TEST_FUNCTION (z, x, rnd);
#endif
if (mpfr_erangeflag_p ())
goto next_n;
if (mpfr_nan_p (z) || mpfr_cmp (t, z) != 0)
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, xprec, x, GMP_RNDN);
#ifdef TWO_ARGS
printf ("\nu=");
mpfr_out_str (stdout, 2, xprec, u, GMP_RNDN);
#elif defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
printf ("\nu=");
mpfr_out_str (stdout, 2, IEEE_DBL_MANT_DIG, u, GMP_RNDN);
#endif
printf (" prec=%u rnd_mode=%s\n", (unsigned) prec,
mpfr_print_rnd_mode (rnd));
printf ("got ");
mpfr_out_str (stdout, 2, prec, z, GMP_RNDN);
puts ("");
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, GMP_RNDN);
puts ("");
printf ("approx ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
compare2 = mpfr_cmp (t, y);
/* if rounding to nearest, cannot know the sign of t - f(x)
because of composed rounding: y = o(f(x)) and t = o(y) */
if (compare * compare2 >= 0)
compare = compare + compare2;
else
compare = inexact; /* cannot determine sign(t-f(x)) */
if (((inexact == 0) && (compare != 0)) ||
((inexact > 0) && (compare <= 0)) ||
((inexact < 0) && (compare >= 0)))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d"
"\n", mpfr_print_rnd_mode (rnd), compare, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
printf ("u="); mpfr_print_binary (u); puts ("");
#endif
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("t="); mpfr_print_binary (t); puts ("");
exit (1);
}
}
else if (getenv ("MPFR_SUSPICIOUS_OVERFLOW") != NULL)
{
/* For developers only! */
MPFR_ASSERTN (MPFR_IS_PURE_FP (y));
mpfr_nexttoinf (y);
if (MPFR_IS_INF (y) && MPFR_IS_LIKE_RNDZ (rnd, MPFR_IS_NEG (y))
&& !mpfr_overflow_p ())
{
printf ("Possible bug! |y| is the maximum finite number "
"and has been obtained when\nrounding toward zero"
" (%s). Thus there is a very probable overflow,\n"
"but the overflow flag is not set!\n",
mpfr_print_rnd_mode (rnd));
printf ("x="); mpfr_print_binary (x); puts ("");
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
printf ("u="); mpfr_print_binary (u); puts ("");
#endif
exit (1);
}
}
next_n:
/* In case the exponent range has been changed by
tests_default_random() or for special values... */
mpfr_set_emin (old_emin);
mpfr_set_emax (old_emax);
}
}
#ifndef TGENERIC_NOWARNING
if (3 * ctrn < 2 * ctrt)
printf ("Warning! Too few normal cases in generic tests (%lu / %lu)\n",
ctrn, ctrt);
#endif
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
#if defined(TWO_ARGS) || defined(DOUBLE_ARG1) || defined(DOUBLE_ARG2)
mpfr_clear (u);
#endif
}
/* Usage: tzeta - generic tests
tzeta s prec rnd_mode - compute zeta(s) with precision 'prec'
and rounding mode 'mode' */
int
main (int argc, char *argv[])
{
mpfr_t s, y, z;
mpfr_prec_t prec;
mpfr_rnd_t rnd_mode;
int inex;
tests_start_mpfr ();
if (argc != 1 && argc != 4)
{
printf ("Usage: tzeta\n"
" or tzeta s prec rnd_mode\n");
exit (1);
}
if (argc == 4)
{
prec = atoi(argv[2]);
mpfr_init2 (s, prec);
mpfr_init2 (z, prec);
mpfr_set_str (s, argv[1], 10, MPFR_RNDN);
rnd_mode = (mpfr_rnd_t) atoi(argv[3]);
mpfr_zeta (z, s, rnd_mode);
mpfr_out_str (stdout, 10, 0, z, MPFR_RNDN);
printf ("\n");
mpfr_clear (s);
mpfr_clear (z);
return 0;
}
test1();
mpfr_init2 (s, MPFR_PREC_MIN);
mpfr_init2 (y, MPFR_PREC_MIN);
mpfr_init2 (z, MPFR_PREC_MIN);
/* the following seems to loop */
mpfr_set_prec (s, 6);
mpfr_set_prec (z, 6);
mpfr_set_str_binary (s, "1.10010e4");
mpfr_zeta (z, s, MPFR_RNDZ);
mpfr_set_prec (s, 53);
mpfr_set_prec (y, 53);
mpfr_set_prec (z, 53);
mpfr_set_ui (s, 1, MPFR_RNDN);
mpfr_clear_divby0();
mpfr_zeta (z, s, MPFR_RNDN);
if (!mpfr_inf_p (z) || MPFR_SIGN (z) < 0 || !mpfr_divby0_p())
{
printf ("Error in mpfr_zeta for s = 1 (should be +inf) with divby0 flag\n");
exit (1);
}
mpfr_set_str_binary (s, "0.1100011101110111111111111010000110010111001011001011");
mpfr_set_str_binary (y, "-0.11111101111011001001001111111000101010000100000100100E2");
mpfr_zeta (z, s, MPFR_RNDN);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDN)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDZ);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDZ)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDU);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDU)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_nexttoinf (y);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDD)\n");
exit (1);
}
mpfr_set_str_binary (s, "0.10001011010011100110010001100100001011000010011001011");
mpfr_set_str_binary (y, "-0.11010011010010101101110111011010011101111101111010110E1");
mpfr_zeta (z, s, MPFR_RNDN);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDN)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDZ);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDZ)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDU);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDU)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_nexttoinf (y);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDD)\n");
exit (1);
}
mpfr_set_str_binary (s, "0.1100111110100001111110111000110101111001011101000101");
mpfr_set_str_binary (y, "-0.10010111010110000111011111001101100001111011000001010E3");
mpfr_zeta (z, s, MPFR_RNDN);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDN)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDD);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDD)\n");
exit (1);
}
mpfr_nexttozero (y);
mpfr_zeta (z, s, MPFR_RNDZ);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDZ)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDU);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDU)\n");
exit (1);
}
mpfr_set_str (s, "-400000001", 10, MPFR_RNDZ);
mpfr_zeta (z, s, MPFR_RNDN);
if (!(mpfr_inf_p (z) && MPFR_SIGN(z) < 0))
{
printf ("Error in mpfr_zeta (-400000001)\n");
exit (1);
}
mpfr_set_str (s, "-400000003", 10, MPFR_RNDZ);
mpfr_zeta (z, s, MPFR_RNDN);
if (!(mpfr_inf_p (z) && MPFR_SIGN(z) > 0))
{
printf ("Error in mpfr_zeta (-400000003)\n");
exit (1);
}
mpfr_set_prec (s, 34);
mpfr_set_prec (z, 34);
mpfr_set_str_binary (s, "-1.111111100001011110000010001010000e-35");
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_set_str_binary (s, "-1.111111111111111111111111111111111e-2");
if (mpfr_cmp (s, z))
{
printf ("Error in mpfr_zeta, prec=34, MPFR_RNDD\n");
mpfr_dump (z);
exit (1);
}
/* bug found by nightly tests on June 7, 2007 */
mpfr_set_prec (s, 23);
mpfr_set_prec (z, 25);
mpfr_set_str_binary (s, "-1.0110110110001000000000e-27");
mpfr_zeta (z, s, MPFR_RNDN);
mpfr_set_prec (s, 25);
mpfr_set_str_binary (s, "-1.111111111111111111111111e-2");
if (mpfr_cmp (s, z))
{
printf ("Error in mpfr_zeta, prec=25, MPFR_RNDN\n");
printf ("expected "); mpfr_dump (s);
printf ("got "); mpfr_dump (z);
exit (1);
}
/* bug reported by Kevin Rauch on 26 Oct 2007 */
mpfr_set_prec (s, 128);
mpfr_set_prec (z, 128);
mpfr_set_str_binary (s, "-0.1000000000000000000000000000000000000000000000000000000000000001E64");
inex = mpfr_zeta (z, s, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (z) && MPFR_SIGN (z) < 0 && inex < 0);
inex = mpfr_zeta (z, s, MPFR_RNDU);
mpfr_set_inf (s, -1);
mpfr_nextabove (s);
MPFR_ASSERTN (mpfr_equal_p (z, s) && inex > 0);
/* bug reported by Fredrik Johansson on 19 Jan 2016 */
mpfr_set_prec (s, 536);
mpfr_set_ui_2exp (s, 1, -424, MPFR_RNDN);
mpfr_sub_ui (s, s, 128, MPFR_RNDN); /* -128 + 2^(-424) */
for (prec = 6; prec <= 536; prec += 8) /* should go through 318 */
{
mpfr_set_prec (z, prec);
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_set_prec (y, prec + 10);
mpfr_zeta (y, s, MPFR_RNDD);
mpfr_prec_round (y, prec, MPFR_RNDD);
if (! mpfr_equal_p (z, y))
{
printf ("mpfr_zeta fails near -128 for inprec=%lu outprec=%lu\n",
(unsigned long) mpfr_get_prec (s), (unsigned long) prec);
printf ("expected "); mpfr_dump (y);
printf ("got "); mpfr_dump (z);
exit (1);
}
}
mpfr_clear (s);
mpfr_clear (y);
mpfr_clear (z);
test_generic (2, 70, 5);
test2 ();
tests_end_mpfr ();
return 0;
}
/* use Brent's formula exp(x) = (1+r+r^2/2!+r^3/3!+...)^(2^K)*2^n
where x = n*log(2)+(2^K)*r
together with Brent-Kung O(t^(1/2)) algorithm for the evaluation of
power series. The resulting complexity is O(n^(1/3)*M(n)).
*/
int
mpfr_exp_2 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
long n;
unsigned long K, k, l, err; /* FIXME: Which type ? */
int error_r;
mp_exp_t exps;
mp_prec_t q, precy;
int inexact;
mpfr_t r, s, t;
mpz_t ss;
TMP_DECL(marker);
precy = MPFR_PREC(y);
MPFR_TRACE ( printf("Py=%d Px=%d", MPFR_PREC(y), MPFR_PREC(x)) );
MPFR_TRACE ( MPFR_DUMP (x) );
n = (long) (mpfr_get_d1 (x) / LOG2);
/* error bounds the cancelled bits in x - n*log(2) */
if (MPFR_UNLIKELY(n == 0))
error_r = 0;
else
count_leading_zeros (error_r, (mp_limb_t) (n < 0) ? -n : n);
error_r = BITS_PER_MP_LIMB - error_r + 2;
/* for the O(n^(1/2)*M(n)) method, the Taylor series computation of
n/K terms costs about n/(2K) multiplications when computed in fixed
point */
K = (precy < SWITCH) ? __gmpfr_isqrt ((precy + 1) / 2)
: __gmpfr_cuberoot (4*precy);
l = (precy - 1) / K + 1;
err = K + MPFR_INT_CEIL_LOG2 (2 * l + 18);
/* add K extra bits, i.e. failure probability <= 1/2^K = O(1/precy) */
q = precy + err + K + 5;
/*q = ( (q-1)/BITS_PER_MP_LIMB + 1) * BITS_PER_MP_LIMB; */
mpfr_init2 (r, q + error_r);
mpfr_init2 (s, q + error_r);
mpfr_init2 (t, q);
/* the algorithm consists in computing an upper bound of exp(x) using
a precision of q bits, and see if we can round to MPFR_PREC(y) taking
into account the maximal error. Otherwise we increase q. */
for (;;)
{
MPFR_TRACE ( printf("n=%d K=%d l=%d q=%d\n",n,K,l,q) );
/* if n<0, we have to get an upper bound of log(2)
in order to get an upper bound of r = x-n*log(2) */
mpfr_const_log2 (s, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* s is within 1 ulp of log(2) */
mpfr_mul_ui (r, s, (n < 0) ? -n : n, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* r is within 3 ulps of n*log(2) */
if (n < 0)
mpfr_neg (r, r, GMP_RNDD); /* exact */
/* r = floor(n*log(2)), within 3 ulps */
MPFR_TRACE ( MPFR_DUMP (x) );
MPFR_TRACE ( MPFR_DUMP (r) );
mpfr_sub (r, x, r, GMP_RNDU);
/* possible cancellation here: the error on r is at most
3*2^(EXP(old_r)-EXP(new_r)) */
while (MPFR_IS_NEG (r))
{ /* initial approximation n was too large */
n--;
mpfr_add (r, r, s, GMP_RNDU);
}
mpfr_prec_round (r, q, GMP_RNDU);
MPFR_TRACE ( MPFR_DUMP (r) );
MPFR_ASSERTD (MPFR_IS_POS (r));
mpfr_div_2ui (r, r, K, GMP_RNDU); /* r = (x-n*log(2))/2^K, exact */
TMP_MARK(marker);
MY_INIT_MPZ(ss, 3 + 2*((q-1)/BITS_PER_MP_LIMB));
exps = mpfr_get_z_exp (ss, s);
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! */
l = (precy < SWITCH) ?
mpfr_exp2_aux (ss, r, q, &exps) /* naive method */
: mpfr_exp2_aux2 (ss, r, q, &exps); /* Brent/Kung method */
MPFR_TRACE(printf("l=%d q=%d (K+l)*q^2=%1.3e\n", l, q, (K+l)*(double)q*q));
for (k = 0; k < K; k++)
{
mpz_mul (ss, ss, ss);
exps <<= 1;
exps += mpz_normalize (ss, ss, q);
}
mpfr_set_z (s, ss, GMP_RNDN);
MPFR_SET_EXP(s, MPFR_GET_EXP (s) + exps);
TMP_FREE(marker); /* don't need ss anymore */
if (n>0)
mpfr_mul_2ui(s, s, n, GMP_RNDU);
else
mpfr_div_2ui(s, s, -n, GMP_RNDU);
/* error is at most 2^K*(3l*(l+1)) ulp for mpfr_exp2_aux */
l = (precy < SWITCH) ? 3*l*(l+1) : l*(l+4) ;
k = MPFR_INT_CEIL_LOG2 (l);
/* k = 0; while (l) { k++; l >>= 1; } */
/* now k = ceil(log(error in ulps)/log(2)) */
K += k;
MPFR_TRACE ( printf("after mult. by 2^n:\n") );
MPFR_TRACE ( MPFR_DUMP (s) );
MPFR_TRACE ( printf("err=%d bits\n", K) );
if (mpfr_can_round (s, q - K, GMP_RNDN, GMP_RNDZ,
precy + (rnd_mode == GMP_RNDN)) )
break;
MPFR_TRACE (printf("prec++, use %d\n", q+BITS_PER_MP_LIMB) );
MPFR_TRACE (printf("q=%d q-K=%d precy=%d\n",q,q-K,precy) );
q += BITS_PER_MP_LIMB;
mpfr_set_prec (r, q);
mpfr_set_prec (s, q);
mpfr_set_prec (t, q);
}
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
mpfr_clear (t);
return inexact;
}
int
mpfr_erf (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xf;
mp_limb_t xf_limb[(53 - 1) / GMP_NUMB_BITS + 1];
int inex, large;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inex));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x)) /* erf(+inf) = +1, erf(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (x), MPFR_RNDN);
else /* erf(+0) = +0, erf(-0) = -0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set (y, x, MPFR_RNDN); /* should keep the sign of x */
}
}
/* now x is neither NaN, Inf nor 0 */
/* first try expansion at x=0 when x is small, or asymptotic expansion
where x is large */
MPFR_SAVE_EXPO_MARK (expo);
/* around x=0, we have erf(x) = 2x/sqrt(Pi) (1 - x^2/3 + ...),
with 1 - x^2/3 <= sqrt(Pi)*erf(x)/2/x <= 1 for x >= 0. This means that
if x^2/3 < 2^(-PREC(y)-1) we can decide of the correct rounding,
unless we have a worst-case for 2x/sqrt(Pi). */
if (MPFR_EXP(x) < - (mpfr_exp_t) (MPFR_PREC(y) / 2))
{
/* we use 2x/sqrt(Pi) (1 - x^2/3) <= erf(x) <= 2x/sqrt(Pi) for x > 0
and 2x/sqrt(Pi) <= erf(x) <= 2x/sqrt(Pi) (1 - x^2/3) for x < 0.
In both cases |2x/sqrt(Pi) (1 - x^2/3)| <= |erf(x)| <= |2x/sqrt(Pi)|.
We will compute l and h such that l <= |2x/sqrt(Pi) (1 - x^2/3)|
and |2x/sqrt(Pi)| <= h. If l and h round to the same value to
precision PREC(y) and rounding rnd_mode, then we are done. */
mpfr_t l, h; /* lower and upper bounds for erf(x) */
int ok, inex2;
mpfr_init2 (l, MPFR_PREC(y) + 17);
mpfr_init2 (h, MPFR_PREC(y) + 17);
/* first compute l */
mpfr_mul (l, x, x, MPFR_RNDU);
mpfr_div_ui (l, l, 3, MPFR_RNDU); /* upper bound on x^2/3 */
mpfr_ui_sub (l, 1, l, MPFR_RNDZ); /* lower bound on 1 - x^2/3 */
mpfr_const_pi (h, MPFR_RNDU); /* upper bound of Pi */
mpfr_sqrt (h, h, MPFR_RNDU); /* upper bound on sqrt(Pi) */
mpfr_div (l, l, h, MPFR_RNDZ); /* lower bound on 1/sqrt(Pi) (1 - x^2/3) */
mpfr_mul_2ui (l, l, 1, MPFR_RNDZ); /* 2/sqrt(Pi) (1 - x^2/3) */
mpfr_mul (l, l, x, MPFR_RNDZ); /* |l| is a lower bound on
|2x/sqrt(Pi) (1 - x^2/3)| */
/* now compute h */
mpfr_const_pi (h, MPFR_RNDD); /* lower bound on Pi */
mpfr_sqrt (h, h, MPFR_RNDD); /* lower bound on sqrt(Pi) */
mpfr_div_2ui (h, h, 1, MPFR_RNDD); /* lower bound on sqrt(Pi)/2 */
/* since sqrt(Pi)/2 < 1, the following should not underflow */
mpfr_div (h, x, h, MPFR_IS_POS(x) ? MPFR_RNDU : MPFR_RNDD);
/* round l and h to precision PREC(y) */
inex = mpfr_prec_round (l, MPFR_PREC(y), rnd_mode);
inex2 = mpfr_prec_round (h, MPFR_PREC(y), rnd_mode);
/* Caution: we also need inex=inex2 (inex might be 0). */
ok = SAME_SIGN (inex, inex2) && mpfr_cmp (l, h) == 0;
if (ok)
mpfr_set (y, h, rnd_mode);
mpfr_clear (l);
mpfr_clear (h);
if (ok)
goto end;
/* this test can still fail for small precision, for example
for x=-0.100E-2 with a target precision of 3 bits, since
the error term x^2/3 is not that small. */
}
MPFR_TMP_INIT1(xf_limb, xf, 53);
mpfr_div (xf, x, __gmpfr_const_log2_RNDU, MPFR_RNDZ); /* round to zero
ensures we get a lower bound of |x/log(2)| */
mpfr_mul (xf, xf, x, MPFR_RNDZ);
large = mpfr_cmp_ui (xf, MPFR_PREC (y) + 1) > 0;
/* when x goes to infinity, we have erf(x) = 1 - 1/sqrt(Pi)/exp(x^2)/x + ...
and |erf(x) - 1| <= exp(-x^2) is true for any x >= 0, thus if
exp(-x^2) < 2^(-PREC(y)-1) the result is 1 or 1-epsilon.
This rewrites as x^2/log(2) > p+1. */
if (MPFR_UNLIKELY (large))
/* |erf x| = 1 or 1- */
{
mpfr_rnd_t rnd2 = MPFR_IS_POS (x) ? rnd_mode : MPFR_INVERT_RND(rnd_mode);
if (rnd2 == MPFR_RNDN || rnd2 == MPFR_RNDU || rnd2 == MPFR_RNDA)
{
inex = MPFR_INT_SIGN (x);
mpfr_set_si (y, inex, rnd2);
}
else /* round to zero */
{
inex = -MPFR_INT_SIGN (x);
mpfr_setmax (y, 0); /* warning: setmax keeps the old sign of y */
MPFR_SET_SAME_SIGN (y, x);
}
}
else /* use Taylor */
{
double xf2;
/* FIXME: get rid of doubles/mpfr_get_d here */
xf2 = mpfr_get_d (x, MPFR_RNDN);
xf2 = xf2 * xf2; /* xf2 ~ x^2 */
inex = mpfr_erf_0 (y, x, xf2, rnd_mode);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd_mode);
}
static void
large (mpfr_exp_t e)
{
mpfr_t x, y, z;
mpfr_exp_t emax;
int inex;
unsigned int flags;
emax = mpfr_get_emax ();
set_emax (e);
mpfr_init2 (x, 8);
mpfr_init2 (y, 8);
mpfr_init2 (z, 4);
mpfr_set_inf (x, 1);
mpfr_nextbelow (x);
mpfr_mul_2si (y, x, -1, MPFR_RNDU);
mpfr_prec_round (y, 4, MPFR_RNDU);
mpfr_clear_flags ();
inex = mpfr_mul_2si (z, x, -1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_mul_2si\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_div_2si (z, x, 1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_div_2si\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_div_2ui (z, x, 1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_div_2ui\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
set_emax (emax);
}
int
main (void)
{
mpfr_t x;
mpfr_exp_t emax;
tests_start_mpfr ();
mpfr_init (x);
mpfr_set_nan (x);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_inf (x, -1);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x));
emax = mpfr_get_emax ();
set_emax (0);
mpfr_set_prec (x, 3);
mpfr_set_str_binary (x, "0.111");
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
set_emax (emax);
mpfr_set_prec (x, mp_bits_per_limb + 2);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_nextbelow (x);
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
if (mpfr_cmp_ui(x, 4))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 4\n");
exit (1);
}
/* check case when reallocation is needed */
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
if (mpfr_cmp_ui(x, 5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 5\n");
exit (1);
}
mpfr_clear(x);
mpfr_init2 (x, 3);
mpfr_set_si (x, -5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
if (mpfr_cmp_si(x, -5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of -5\n");
exit (1);
}
/* check case when new precision needs less limbs */
mpfr_set_prec (x, mp_bits_per_limb + 1);
mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, 3, MPFR_RNDN); /* exact */
if (mpfr_cmp_ui(x, 5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 5\n");
exit (1);
}
mpfr_clear(x);
tests_end_mpfr ();
return 0;
}
static void
check_special (void)
{
mpfr_t x, y, z;
mpfr_exp_t emin, emax;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
/* check exp(NaN) = NaN */
mpfr_set_nan (x);
test_exp (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for exp(NaN)\n");
exit (1);
}
/* check exp(+inf) = +inf */
mpfr_set_inf (x, 1);
test_exp (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(+inf)\n");
exit (1);
}
/* check exp(-inf) = +0 */
mpfr_set_inf (x, -1);
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(-inf)\n");
exit (1);
}
/* Check overflow. Corner case of mpfr_exp_2 */
mpfr_set_prec (x, 64);
mpfr_set_emax (MPFR_EMAX_DEFAULT);
mpfr_set_emin (MPFR_EMIN_DEFAULT);
mpfr_set_str (x,
"0.1011000101110010000101111111010100001100000001110001100111001101E30",
2, MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDD);
if (mpfr_cmp_str (x,
".1111111111111111111111111111111111111111111111111111111111111111E1073741823",
2, MPFR_RNDN) != 0)
{
printf ("Wrong overflow detection in mpfr_exp\n");
mpfr_dump (x);
exit (1);
}
/* Check underflow. Corner case of mpfr_exp_2 */
mpfr_set_str (x,
"-0.1011000101110010000101111111011111010001110011110111100110101100E30",
2, MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDN);
if (mpfr_cmp_str (x, "0.1E-1073741823", 2, MPFR_RNDN) != 0)
{
printf ("Wrong underflow (1) detection in mpfr_exp\n");
mpfr_dump (x);
exit (1);
}
mpfr_set_str (x,
"-0.1011001101110010000101111111011111010001110011110111100110111101E30",
2, MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) != 0)
{
printf ("Wrong underflow (2) detection in mpfr_exp\n");
mpfr_dump (x);
exit (1);
}
/* Check overflow. Corner case of mpfr_exp_3 */
if (MPFR_PREC_MAX >= MPFR_EXP_THRESHOLD + 10 && MPFR_PREC_MAX >= 64)
{
/* this ensures that for small MPFR_EXP_THRESHOLD, the following
mpfr_set_str conversion is exact */
mpfr_set_prec (x, (MPFR_EXP_THRESHOLD + 10 > 64)
? MPFR_EXP_THRESHOLD + 10 : 64);
mpfr_set_str (x,
"0.1011000101110010000101111111010100001100000001110001100111001101E30",
2, MPFR_RNDN);
mpfr_clear_overflow ();
mpfr_exp (x, x, MPFR_RNDD);
if (!mpfr_overflow_p ())
{
printf ("Wrong overflow detection in mpfr_exp_3\n");
mpfr_dump (x);
exit (1);
}
/* Check underflow. Corner case of mpfr_exp_3 */
mpfr_set_str (x,
"-0.1011000101110010000101111111011111010001110011110111100110101100E30",
2, MPFR_RNDN);
mpfr_clear_underflow ();
mpfr_exp (x, x, MPFR_RNDN);
if (!mpfr_underflow_p ())
{
printf ("Wrong underflow detection in mpfr_exp_3\n");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 53);
}
/* check overflow */
set_emax (10);
mpfr_set_ui (x, 7, MPFR_RNDN);
test_exp (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(7) for emax=10\n");
exit (1);
}
set_emax (emax);
/* check underflow */
set_emin (-10);
mpfr_set_si (x, -9, MPFR_RNDN);
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(-9) for emin=-10\n");
printf ("Expected +0\n");
printf ("Got ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
set_emin (emin);
/* check case EXP(x) < -precy */
mpfr_set_prec (y, 2);
mpfr_set_str_binary (x, "-0.1E-3");
test_exp (y, x, MPFR_RNDD);
if (mpfr_cmp_ui_2exp (y, 3, -2))
{
printf ("Error for exp(-1/16), prec=2, RNDD\n");
printf ("expected 0.11, got ");
mpfr_dump (y);
exit (1);
}
test_exp (y, x, MPFR_RNDZ);
if (mpfr_cmp_ui_2exp (y, 3, -2))
{
printf ("Error for exp(-1/16), prec=2, RNDZ\n");
printf ("expected 0.11, got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_str_binary (x, "0.1E-3");
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error for exp(1/16), prec=2, RNDN\n");
exit (1);
}
test_exp (y, x, MPFR_RNDU);
if (mpfr_cmp_ui_2exp (y, 3, -1))
{
printf ("Error for exp(1/16), prec=2, RNDU\n");
exit (1);
}
/* bug reported by Franky Backeljauw, 28 Mar 2003 */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "1.1101011000111101011110000111010010101001101001110111e28");
test_exp (y, x, MPFR_RNDN);
mpfr_set_prec (x, 153);
mpfr_set_prec (z, 153);
mpfr_set_str_binary (x, "1.1101011000111101011110000111010010101001101001110111e28");
test_exp (z, x, MPFR_RNDN);
mpfr_prec_round (z, 53, MPFR_RNDN);
if (mpfr_cmp (y, z))
{
printf ("Error in mpfr_exp for large argument\n");
exit (1);
}
/* corner cases in mpfr_exp_3 */
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_prec (y, 2);
mpfr_exp_3 (y, x, MPFR_RNDN);
/* Check some little things about overflow detection */
set_emin (-125);
set_emax (128);
mpfr_set_prec (x, 107);
mpfr_set_prec (y, 107);
mpfr_set_str_binary (x, "0.11110000000000000000000000000000000000000000000"
"0000000000000000000000000000000000000000000000000000"
"00000000E4");
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_str (y, "0.11000111100001100110010101111101011010010101010000"
"1101110111100010111001011111111000110111001011001101010"
"01E22", 2, MPFR_RNDN))
{
printf ("Special overflow error (1)\n");
mpfr_dump (y);
exit (1);
}
set_emin (emin);
set_emax (emax);
/* Check for overflow producing a segfault with HUGE exponent */
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_mul_2ui (x, x, 32, MPFR_RNDN);
test_exp (y, x, MPFR_RNDN); /* Can't test return value: May overflow or not*/
/* Bug due to wrong approximation of (x)/log2 */
mpfr_set_prec (x, 163);
mpfr_set_str (x, "-4.28ac8fceeadcda06bb56359017b1c81b85b392e7", 16,
MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDN);
if (mpfr_cmp_str (x, "3.fffffffffffffffffffffffffffffffffffffffe8@-2",
16, MPFR_RNDN))
{
printf ("Error for x= -4.28ac8fceeadcda06bb56359017b1c81b85b392e7");
printf ("expected 3.fffffffffffffffffffffffffffffffffffffffe8@-2");
printf ("Got ");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
putchar ('\n');
}
/* bug found by Guillaume Melquiond, 13 Sep 2005 */
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "-1E-400");
mpfr_exp (x, x, MPFR_RNDZ);
if (mpfr_cmp_ui (x, 1) == 0)
{
printf ("Error for exp(-2^(-400))\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
