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 */
{
void
arb_atan_arf_via_mpfr(arb_t z, const arf_t x, slong prec)
{
mpfr_t t, u;
int exact;
mpfr_init2(t, 2 + arf_bits(x));
mpfr_init2(u, prec);
mpfr_set_emin(MPFR_EMIN_MIN);
mpfr_set_emax(MPFR_EMAX_MAX);
arf_get_mpfr(t, x, MPFR_RNDD);
exact = (mpfr_atan(u, t, MPFR_RNDD) == 0);
arf_set_mpfr(arb_midref(z), u);
if (!exact)
arf_mag_set_ulp(arb_radref(z), arb_midref(z), prec);
mpfr_clear(t);
mpfr_clear(u);
}
SEXP R_mpfr_set_erange(SEXP kind_, SEXP val) {
erange_kind kind = asInteger(kind_);
mpfr_exp_t exp_val;
if(isInteger(val))
exp_val = asInteger(val);// assume this is always valid to set
else { // we allow larger values from the R side
PROTECT(val = coerceVector(val, REALSXP));
exp_val = (mpfr_exp_t) asReal(val);
UNPROTECT(1);
}
int i_err;
switch(kind) {
case E_min: i_err = mpfr_set_emin(exp_val); break;
case E_max: i_err = mpfr_set_emax(exp_val); break;
default:
error("invalid kind (code = %d) in R_mpfr_set_erange()", kind);
}
if(i_err) warning("e%s exponent could not be set to %ld (code %d)",
(kind == E_min) ? "min" : "max", (long)exp_val, i_err);
return ScalarInteger(i_err);
}
/* 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);
}
static int
tiny_aux (int stop, mpfr_exp_t e)
{
mpfr_t x, y, z;
int r, s, spm, inex, err = 0;
int expected_dir[2][5] = { { 1, -1, 1, -1, 1 }, { 1, 1, 1, -1, -1 } };
mpfr_exp_t saved_emax;
saved_emax = mpfr_get_emax ();
mpfr_init2 (x, 32);
mpfr_inits2 (8, y, z, (mpfr_ptr) 0);
mpfr_set_ui_2exp (x, 1, e, MPFR_RNDN);
spm = 1;
for (s = 0; s < 2; s++)
{
RND_LOOP(r)
{
mpfr_rnd_t rr = (mpfr_rnd_t) r;
mpfr_exp_t exponent, emax;
/* Exponent of the rounded value in unbounded exponent range. */
exponent = expected_dir[s][r] < 0 && s == 0 ? - e : 1 - e;
for (emax = exponent - 1; emax <= exponent; emax++)
{
unsigned int flags, expected_flags = MPFR_FLAGS_INEXACT;
int overflow, expected_inex = expected_dir[s][r];
if (emax > MPFR_EMAX_MAX)
break;
mpfr_set_emax (emax);
mpfr_clear_flags ();
inex = mpfr_gamma (y, x, rr);
flags = __gmpfr_flags;
mpfr_clear_flags ();
mpfr_set_si_2exp (z, spm, - e, MPFR_RNDU);
overflow = mpfr_overflow_p ();
/* z is 1/x - euler rounded toward +inf */
if (overflow && rr == MPFR_RNDN && s == 1)
expected_inex = -1;
if (expected_inex < 0)
mpfr_nextbelow (z); /* 1/x - euler rounded toward -inf */
if (exponent > emax)
expected_flags |= MPFR_FLAGS_OVERFLOW;
if (!(mpfr_equal_p (y, z) && flags == expected_flags
&& SAME_SIGN (inex, expected_inex)))
{
printf ("Error in tiny for s = %d, r = %s, emax = %"
MPFR_EXP_FSPEC "d%s\n on ",
s, mpfr_print_rnd_mode (rr), emax,
exponent > emax ? " (overflow)" : "");
mpfr_dump (x);
printf (" expected inex = %2d, ", expected_inex);
mpfr_dump (z);
printf (" got inex = %2d, ", SIGN (inex));
mpfr_dump (y);
printf (" expected flags = %u, got %u\n",
expected_flags, flags);
if (stop)
exit (1);
err = 1;
}
}
}
mpfr_neg (x, x, MPFR_RNDN);
spm = - spm;
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
mpfr_set_emax (saved_emax);
return err;
}
static void
exprange (void)
{
mpfr_exp_t emin, emax;
mpfr_t x, y, z;
int inex1, inex2;
unsigned int flags1, flags2;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init2 (x, 16);
mpfr_inits2 (8, y, z, (mpfr_ptr) 0);
mpfr_set_ui_2exp (x, 5, -1, MPFR_RNDN);
mpfr_clear_flags ();
inex1 = mpfr_gamma (y, x, MPFR_RNDN);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emin (0);
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDN);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emin (emin);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test1)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_ui_2exp (x, 32769, -60, MPFR_RNDN);
mpfr_clear_flags ();
inex1 = mpfr_gamma (y, x, MPFR_RNDD);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (45);
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (emax);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test2)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_emax (44);
mpfr_clear_flags ();
inex1 = mpfr_check_range (y, inex1, MPFR_RNDD);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (emax);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test3)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_ui_2exp (x, 1, -60, MPFR_RNDN);
mpfr_clear_flags ();
inex1 = mpfr_gamma (y, x, MPFR_RNDD);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (60);
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (emax);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test4)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
MPFR_ASSERTN (MPFR_EMIN_MIN == - MPFR_EMAX_MAX);
mpfr_set_emin (MPFR_EMIN_MIN);
mpfr_set_emax (MPFR_EMAX_MAX);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_nextabove (x); /* x = 2^(emin - 1) */
mpfr_set_inf (y, 1);
inex1 = 1;
flags1 = MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
mpfr_clear_flags ();
/* MPFR_RNDU: overflow, infinity since 1/x = 2^(emax + 1) */
inex2 = mpfr_gamma (z, x, MPFR_RNDU);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test5)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
/* MPFR_RNDN: overflow, infinity since 1/x = 2^(emax + 1) */
inex2 = mpfr_gamma (z, x, MPFR_RNDN);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test6)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_nextbelow (y);
inex1 = -1;
mpfr_clear_flags ();
/* MPFR_RNDD: overflow, maxnum since 1/x = 2^(emax + 1) */
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test7)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_mul_2ui (x, x, 1, MPFR_RNDN); /* x = 2^emin */
mpfr_set_inf (y, 1);
inex1 = 1;
flags1 = MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
mpfr_clear_flags ();
/* MPFR_RNDU: overflow, infinity since 1/x = 2^emax */
inex2 = mpfr_gamma (z, x, MPFR_RNDU);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test8)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
/* MPFR_RNDN: overflow, infinity since 1/x = 2^emax */
inex2 = mpfr_gamma (z, x, MPFR_RNDN);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test9)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_nextbelow (y);
inex1 = -1;
flags1 = MPFR_FLAGS_INEXACT;
mpfr_clear_flags ();
/* MPFR_RNDD: no overflow, maxnum since 1/x = 2^emax and euler > 0 */
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test10)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_emin (emin);
mpfr_set_emax (emax);
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
static void
test_extreme (void)
{
mpfr_t x, y, z;
mpfr_exp_t emin, emax;
mpfr_prec_t p[4] = { 8, 32, 64, 256 };
int xi, yi, zi, j, r;
unsigned int flags, ex_flags;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_set_emin (MPFR_EMIN_MIN);
mpfr_set_emax (MPFR_EMAX_MAX);
for (xi = 0; xi < 4; xi++)
{
mpfr_init2 (x, p[xi]);
mpfr_setmax (x, MPFR_EMAX_MAX);
MPFR_ASSERTN (mpfr_check (x));
for (yi = 0; yi < 4; yi++)
{
mpfr_init2 (y, p[yi]);
mpfr_setmin (y, MPFR_EMIN_MIN);
for (j = 0; j < 2; j++)
{
MPFR_ASSERTN (mpfr_check (y));
for (zi = 0; zi < 4; zi++)
{
mpfr_init2 (z, p[zi]);
RND_LOOP (r)
{
mpfr_clear_flags ();
mpfr_div (z, x, y, (mpfr_rnd_t) r);
flags = __gmpfr_flags;
MPFR_ASSERTN (mpfr_check (z));
ex_flags = MPFR_FLAGS_OVERFLOW | MPFR_FLAGS_INEXACT;
if (flags != ex_flags)
{
printf ("Bad flags in test_extreme on z = a/b"
" with %s and\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r));
printf ("a = ");
mpfr_dump (x);
printf ("b = ");
mpfr_dump (y);
printf ("Expected flags:");
flags_out (ex_flags);
printf ("Got flags: ");
flags_out (flags);
printf ("z = ");
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
mpfr_div (z, y, x, (mpfr_rnd_t) r);
flags = __gmpfr_flags;
MPFR_ASSERTN (mpfr_check (z));
ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT;
if (flags != ex_flags)
{
printf ("Bad flags in test_extreme on z = a/b"
" with %s and\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r));
printf ("a = ");
mpfr_dump (y);
printf ("b = ");
mpfr_dump (x);
printf ("Expected flags:");
flags_out (ex_flags);
printf ("Got flags: ");
flags_out (flags);
printf ("z = ");
mpfr_dump (z);
exit (1);
}
}
mpfr_clear (z);
} /* zi */
mpfr_nextabove (y);
} /* j */
mpfr_clear (y);
} /* yi */
mpfr_clear (x);
} /* xi */
set_emin (emin);
set_emax (emax);
}
int
main (int argc, char *argv[])
{
mpfr_t x;
long k, z, d;
unsigned long zl, dl, N;
int inex;
mpfr_init2(x, 100);
SEED_RAND (time(NULL));
N = (argc==1) ? 1000000 : atoi(argv[1]);
for (k = 1; k <= N; k++)
{
z = random() - (1 << 30);
inex = mpfr_set_si(x, z, GMP_RNDZ);
d = (long) mpfr_get_d1 (x);
if (d != z) {
fprintf(stderr, "Error in mpfr_set_si: expected %ld got %ld\n", z, d);
exit(1);
}
if (inex)
{
fprintf(stderr,
"Error in mpfr_set_si: inex value incorrect for %ld: %d\n",
z, inex);
exit(1);
}
}
for (k = 1; k <= N; k++)
{
zl = random();
inex = mpfr_set_ui (x, zl, GMP_RNDZ);
dl = (unsigned long) mpfr_get_d1 (x);
if (dl != zl) {
fprintf(stderr, "Error in mpfr_set_ui: expected %lu got %lu\n", zl, dl);
exit(1);
}
if (inex)
{
fprintf(stderr,
"Error in mpfr_set_ui: inex value incorrect for %lu: %d\n",
zl, inex);
exit(1);
}
}
mpfr_set_prec (x, 2);
if (mpfr_set_si (x, 5, GMP_RNDZ) >= 0)
{
fprintf (stderr, "Wrong inexact flag for x=5, rnd=GMP_RNDZ\n");
exit (1);
}
mpfr_set_prec (x, 2);
if (mpfr_set_si (x, -5, GMP_RNDZ) <= 0)
{
fprintf (stderr, "Wrong inexact flag for x=-5, rnd=GMP_RNDZ\n");
exit (1);
}
mpfr_set_prec (x, 3);
inex = mpfr_set_si(x, 77617, GMP_RNDD); /* should be 65536 */
if (MPFR_MANT(x)[0] != ((mp_limb_t)1 << (mp_bits_per_limb-1))
|| inex >= 0)
{
fprintf(stderr, "Error in mpfr_set_si(x:3, 77617, GMP_RNDD)\n");
mpfr_print_binary(x);
putchar('\n');
exit(1);
}
inex = mpfr_set_ui(x, 77617, GMP_RNDD); /* should be 65536 */
if (MPFR_MANT(x)[0] != ((mp_limb_t)1 << (mp_bits_per_limb-1))
|| inex >= 0)
{
fprintf(stderr, "Error in mpfr_set_ui(x:3, 77617, GMP_RNDD)\n");
mpfr_print_binary(x);
putchar('\n');
exit(1);
}
mpfr_set_prec(x, 2);
inex = mpfr_set_si(x, 33096, GMP_RNDU);
if (mpfr_get_d1 (x) != 49152.0 || inex <= 0)
{
fprintf(stderr, "Error in mpfr_set_si, expected 49152, got %lu, inex %d\n",
(unsigned long) mpfr_get_d1 (x), inex);
exit(1);
}
inex = mpfr_set_ui(x, 33096, GMP_RNDU);
if (mpfr_get_d1 (x) != 49152.0)
{
fprintf(stderr, "Error in mpfr_set_ui, expected 49152, got %lu, inex %d\n",
(unsigned long) mpfr_get_d1 (x), inex);
exit(1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_set_ui (x, 0, GMP_RNDN);
if (MPFR_SIGN (x) < 0)
{
fprintf (stderr, "mpfr_set_ui (x, 0) gives -0\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_set_si (x, 0, GMP_RNDN);
if (MPFR_SIGN (x) < 0)
{
fprintf (stderr, "mpfr_set_si (x, 0) gives -0\n");
exit (1);
}
/* check potential bug in case mp_limb_t is unsigned */
mpfr_set_emax (0);
mpfr_set_si (x, -1, GMP_RNDN);
if (mpfr_sgn (x) >= 0)
{
fprintf (stderr, "mpfr_set_si (x, -1) fails\n");
exit (1);
}
mpfr_set_emax (5);
mpfr_set_prec (x, 2);
mpfr_set_si (x, -31, GMP_RNDN);
if (mpfr_sgn (x) >= 0)
{
fprintf (stderr, "mpfr_set_si (x, -31) fails\n");
exit (1);
}
mpfr_clear(x);
return 0;
}
static void
consistency (void)
{
mpfr_t x, s1, s2, c1, c2;
mpfr_exp_t emin, emax;
mpfr_rnd_t rnd;
unsigned int flags_sin, flags_cos, flags, flags_before, flags_ref;
int inex_sin, is, inex_cos, ic, inex, inex_ref;
int i;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
for (i = 0; i <= 10000; i++)
{
mpfr_init2 (x, MPFR_PREC_MIN + (randlimb () % 8));
mpfr_inits2 (MPFR_PREC_MIN + (randlimb () % 8), s1, s2, c1, c2,
(mpfr_ptr) 0);
if (i < 8 * MPFR_RND_MAX)
{
int j = i / MPFR_RND_MAX;
if (j & 1)
mpfr_set_emin (MPFR_EMIN_MIN);
mpfr_set_si (x, (j & 2) ? 1 : -1, MPFR_RNDN);
mpfr_set_exp (x, mpfr_get_emin ());
rnd = (mpfr_rnd_t) (i % MPFR_RND_MAX);
flags_before = 0;
if (j & 4)
mpfr_set_emax (-17);
}
else
{
tests_default_random (x, 256, -5, 50, 0);
rnd = RND_RAND ();
flags_before = (randlimb () & 1) ?
(unsigned int) (MPFR_FLAGS_ALL ^ MPFR_FLAGS_ERANGE) :
(unsigned int) 0;
}
__gmpfr_flags = flags_before;
inex_sin = mpfr_sin (s1, x, rnd);
is = inex_sin < 0 ? 2 : inex_sin > 0 ? 1 : 0;
flags_sin = __gmpfr_flags;
__gmpfr_flags = flags_before;
inex_cos = mpfr_cos (c1, x, rnd);
ic = inex_cos < 0 ? 2 : inex_cos > 0 ? 1 : 0;
flags_cos = __gmpfr_flags;
__gmpfr_flags = flags_before;
inex = mpfr_sin_cos (s2, c2, x, rnd);
flags = __gmpfr_flags;
inex_ref = is + 4 * ic;
flags_ref = flags_sin | flags_cos;
if (!(mpfr_equal_p (s1, s2) && mpfr_equal_p (c1, c2)) ||
inex != inex_ref || flags != flags_ref)
{
printf ("mpfr_sin_cos and mpfr_sin/mpfr_cos disagree on %s,"
" i = %d\nx = ", mpfr_print_rnd_mode (rnd), i);
mpfr_dump (x);
printf ("s1 = ");
mpfr_dump (s1);
printf ("s2 = ");
mpfr_dump (s2);
printf ("c1 = ");
mpfr_dump (c1);
printf ("c2 = ");
mpfr_dump (c2);
printf ("inex_sin = %d (s = %d), inex_cos = %d (c = %d), "
"inex = %d (expected %d)\n",
inex_sin, is, inex_cos, ic, inex, inex_ref);
printf ("flags_sin = 0x%x, flags_cos = 0x%x, "
"flags = 0x%x (expected 0x%x)\n",
flags_sin, flags_cos, flags, flags_ref);
exit (1);
}
mpfr_clears (x, s1, s2, c1, c2, (mpfr_ptr) 0);
mpfr_set_emin (emin);
mpfr_set_emax (emax);
}
}
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);
}
static void
special (void)
{
mpfr_t x, y;
int inex;
int sign;
mpfr_exp_t emin, emax;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lgamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != -1)
{
printf ("Error for lgamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(2)\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"
mpfr_set_str (x, CHECK_X1, 10, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, MPFR_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X1") is wrong:\n"
"expected ");
mpfr_dump (x);
printf ("got ");
mpfr_dump (y);
exit (1);
}
#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
mpfr_set_str (x, CHECK_X2, 10, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, MPFR_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X2") is wrong:\n"
"expected ");
mpfr_dump (x);
printf ("got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 175);
mpfr_set_ui (x, 33, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, MPFR_RNDN);
sign = -17;
mpfr_lgamma (x, &sign, y, MPFR_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (120)\n");
printf ("Expected "); mpfr_dump (y);
printf ("Got "); mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 206);
mpfr_set_str_binary (x, "0.110e10");
sign = -17;
inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lgamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(0.1100E-66)\n");
printf ("Expected ");
mpfr_dump (x);
printf ("Got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(-2^199+0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != -1)
{
printf ("Error for lgamma(-2^199-0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("with sign %d instead of ", sign);
mpfr_dump (x);
printf ("with sign -1.\n");
exit (1);
}
mpfr_set_prec (x, 10);
mpfr_set_prec (y, 10);
mpfr_set_str_binary (x, "-0.1101111000E-3");
inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, "10.01001011");
if (mpfr_equal_p (x, y) == 0 || sign != -1 || inex >= 0)
{
printf ("Error for lgamma(-0.1101111000E-3)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
printf ("with sign %d instead of -1 (inex=%d).\n", sign, inex);
exit (1);
}
mpfr_set_prec (x, 18);
mpfr_set_prec (y, 28);
mpfr_set_str_binary (x, "-1.10001101010001101e-196");
inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_prec (x, 28);
mpfr_set_str_binary (x, "0.100001110110101011011010011E8");
MPFR_ASSERTN (mpfr_equal_p (x, y) && inex < 0);
/* values reported by Kaveh Ghazi on 14 Jul 2007, where mpfr_lgamma()
takes forever */
#define VAL1 "-0.11100001001010110111001010001001001011110100110000110E-55"
#define OUT1 "100110.01000000010111001110110101110101001001100110111"
#define VAL2 "-0.11100001001010110111001010001001001011110011111111100E-55"
#define OUT2 "100110.0100000001011100111011010111010100100110011111"
#define VAL3 "-0.11100001001010110111001010001001001001110101101010100E-55"
#define OUT3 "100110.01000000010111001110110101110101001011110111011"
#define VAL4 "-0.10001111110110110100100100000000001111110001001001011E-57"
#define OUT4 "101000.0001010111110011101101000101111111010001100011"
#define VAL5 "-0.10001111110110110100100100000000001111011111100001000E-57"
#define OUT5 "101000.00010101111100111011010001011111110100111000001"
#define VAL6 "-0.10001111110110110100100100000000001111011101100011001E-57"
#define OUT6 "101000.0001010111110011101101000101111111010011101111"
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, VAL1);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, OUT1);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p(x, y));
mpfr_set_str_binary (x, VAL2);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, OUT2);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL3);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, OUT3);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL4);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, OUT4);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL5);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, OUT5);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL6);
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, OUT6);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
/* further test from Kaveh Ghazi */
mpfr_set_str_binary (x, "-0.10011010101001010010001110010111010111011101010111001E-53");
mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, "100101.00111101101010000000101010111010001111001101111");
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
/* bug found by Kevin Rauch on 26 Oct 2007 */
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_set_emin (-1000000000);
mpfr_set_emax (1000000000);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_lgamma (x, &sign, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_get_emin () == -1000000000);
MPFR_ASSERTN(mpfr_get_emax () == 1000000000);
mpfr_set_emin (emin);
mpfr_set_emax (emax);
/* two other bugs reported by Kevin Rauch on 27 Oct 2007 */
mpfr_set_prec (x, 128);
mpfr_set_prec (y, 128);
mpfr_set_str_binary (x, "0.11000110011110111111110010100110000000000000000000000000000000000000000000000000000000000000000001000011000110100100110111101010E-765689");
inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_str_binary (x, "10000001100100101111011011010000111010001001110000111010011000101001011111011111110011011010110100101111110111001001010100011101E-108");
MPFR_ASSERTN(inex < 0 && mpfr_cmp (y, x) == 0 && sign > 0);
mpfr_set_prec (x, 128);
mpfr_set_prec (y, 256);
mpfr_set_str_binary (x, "0.1011111111111111100000111011111E-31871");
inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
mpfr_set_prec (x, 256);
mpfr_set_str (x, "AC9729B83707E6797612D0D76DAF42B1240A677FF1B6E3783FD4E53037143B1P-237", 16, MPFR_RNDN);
MPFR_ASSERTN(inex < 0 && mpfr_cmp (y, x) == 0 && sign > 0);
mpfr_clear (x);
mpfr_clear (y);
}
static void
check1 (void)
{
mpfr_t x;
int i, j, k, s, old_inex, tiny, expj;
mpfr_exp_t emin, emax;
unsigned int expflags, flags;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_set_default_prec (9);
mpfr_set_emin (-10);
mpfr_set_emax (10);
mpfr_init (x);
for (i = 0; i < numberof (tab); i++)
for (s = 0; s <= (tab[i].rnd == MPFR_RNDN); s++)
for (k = 0; k <= 1; k++)
{
mpfr_set_str (x, tab[i].in, 2, MPFR_RNDN);
old_inex = tab[i].i;
expj = tab[i].j;
if (s)
{
mpfr_neg (x, x, MPFR_RNDN);
old_inex = - old_inex;
expj = - expj;
}
if (k && old_inex)
old_inex = old_inex < 0 ? INT_MIN : INT_MAX;
tiny = MPFR_GET_EXP (x) <= -3;
mpfr_clear_flags ();
j = mpfr_subnormalize (x, old_inex, tab[i].rnd);
expflags =
(tiny ? MPFR_FLAGS_UNDERFLOW : 0) |
(expj ? MPFR_FLAGS_INEXACT : 0);
flags = __gmpfr_flags;
if (s)
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_cmp_str (x, tab[i].out, 2, MPFR_RNDN) != 0 ||
flags != expflags || ! SAME_SIGN (j, expj))
{
const char *sgn = s ? "-" : "";
printf ("Error for i = %d (old_inex = %d), k = %d, x = %s%s\n"
"Expected: %s%s\nGot: ", i, old_inex, k,
sgn, tab[i].in, sgn, tab[i].out);
if (s)
mpfr_neg (x, x, MPFR_RNDN);
mpfr_dump (x);
printf ("Expected flags = %u, got %u\n", expflags, flags);
printf ("Expected ternary value = %d, got %d\n", expj, j);
exit (1);
}
}
mpfr_clear (x);
MPFR_ASSERTN (mpfr_get_emin () == -10);
MPFR_ASSERTN (mpfr_get_emax () == 10);
set_emin (emin);
set_emax (emax);
}
/* If x^y is exactly representable (with maybe a larger precision than z),
round it in z and return the (mpc) inexact flag in [0, 10].
If x^y is not exactly representable, return -1.
If intermediate computations lead to numbers of more than maxprec bits,
then abort and return -2 (in that case, to avoid loops, mpc_pow_exact
should be called again with a larger value of maxprec).
Assume one of Re(x) or Im(x) is non-zero, and y is non-zero (y is real).
*/
static int
mpc_pow_exact (mpc_ptr z, mpc_srcptr x, mpfr_srcptr y, mpc_rnd_t rnd,
mp_prec_t maxprec)
{
mp_exp_t ec, ed, ey, emin, emax;
mpz_t my, a, b, c, d, u;
unsigned long int t;
int ret = -2;
mpz_init (my);
mpz_init (a);
mpz_init (b);
mpz_init (c);
mpz_init (d);
mpz_init (u);
ey = mpfr_get_z_exp (my, y);
/* normalize so that my is odd */
t = mpz_scan1 (my, 0);
ey += t;
mpz_tdiv_q_2exp (my, my, t);
if (mpfr_zero_p (MPC_RE(x)))
{
mpz_set_ui (c, 0);
ec = 0;
}
else
ec = mpfr_get_z_exp (c, MPC_RE(x));
if (mpfr_zero_p (MPC_IM(x)))
{
mpz_set_ui (d, 0);
ed = ec;
}
else
{
ed = mpfr_get_z_exp (d, MPC_IM(x));
if (mpfr_zero_p (MPC_RE(x)))
ec = ed;
}
/* x = c*2^ec + I * d*2^ed */
/* equalize the exponents of x */
if (ec < ed)
{
mpz_mul_2exp (d, d, ed - ec);
if (mpz_sizeinbase (d, 2) > maxprec)
goto end;
ed = ec;
}
else if (ed < ec)
{
mpz_mul_2exp (c, c, ec - ed);
if (mpz_sizeinbase (c, 2) > maxprec)
goto end;
ec = ed;
}
/* now ec=ed and x = (c + I * d) * 2^ec */
/* divide by two if possible */
if (mpz_cmp_ui (c, 0) == 0)
{
t = mpz_scan1 (d, 0);
mpz_tdiv_q_2exp (d, d, t);
ec += t;
}
else if (mpz_cmp_ui (d, 0) == 0)
{
t = mpz_scan1 (c, 0);
mpz_tdiv_q_2exp (c, c, t);
ec += t;
}
else /* neither c nor d is zero */
{
unsigned long v;
t = mpz_scan1 (c, 0);
v = mpz_scan1 (d, 0);
if (v < t)
t = v;
mpz_tdiv_q_2exp (c, c, t);
mpz_tdiv_q_2exp (d, d, t);
ec += t;
}
/* now either one of c, d is odd */
while (ey < 0)
{
/* check if x is a square */
if (ec & 1)
{
mpz_mul_2exp (c, c, 1);
mpz_mul_2exp (d, d, 1);
ec --;
}
/* now ec is even */
if (mpc_perfect_square_p (a, b, c, d) == 0)
break;
mpz_swap (a, c);
mpz_swap (b, d);
ec /= 2;
ey ++;
}
if (ey < 0)
{
ret = -1; /* not representable */
goto end;
}
/* Now ey >= 0, it thus suffices to check that x^my is representable.
If my > 0, this is always true. If my < 0, we first try to invert
(c+I*d)*2^ec.
*/
if (mpz_cmp_ui (my, 0) < 0)
{
/* If my < 0, 1 / (c + I*d) = (c - I*d)/(c^2 + d^2), thus a sufficient
condition is that c^2 + d^2 is a power of two, assuming |c| <> |d|.
Assume a prime p <> 2 divides c^2 + d^2,
then if p does not divide c or d, 1 / (c + I*d) cannot be exact.
If p divides both c and d, then we can write c = p*c', d = p*d',
and 1 / (c + I*d) = 1/p * 1/(c' + I*d'). This shows that if 1/(c+I*d)
is exact, then 1/(c' + I*d') is exact too, and we are back to the
previous case. In conclusion, a necessary and sufficient condition
is that c^2 + d^2 is a power of two.
*/
/* FIXME: we could first compute c^2+d^2 mod a limb for example */
mpz_mul (a, c, c);
mpz_addmul (a, d, d);
t = mpz_scan1 (a, 0);
if (mpz_sizeinbase (a, 2) != 1 + t) /* a is not a power of two */
{
ret = -1; /* not representable */
goto end;
}
/* replace (c,d) by (c/(c^2+d^2), -d/(c^2+d^2)) */
mpz_neg (d, d);
ec = -ec - t;
mpz_neg (my, my);
}
/* now ey >= 0 and my >= 0, and we want to compute
[(c + I * d) * 2^ec] ^ (my * 2^ey).
We first compute [(c + I * d) * 2^ec]^my, then square ey times. */
t = mpz_sizeinbase (my, 2) - 1;
mpz_set (a, c);
mpz_set (b, d);
ed = ec;
/* invariant: (a + I*b) * 2^ed = ((c + I*d) * 2^ec)^trunc(my/2^t) */
while (t-- > 0)
{
unsigned long v, w;
/* square a + I*b */
mpz_mul (u, a, b);
mpz_mul (a, a, a);
mpz_submul (a, b, b);
mpz_mul_2exp (b, u, 1);
ed *= 2;
if (mpz_tstbit (my, t)) /* multiply by c + I*d */
{
mpz_mul (u, a, c);
mpz_submul (u, b, d); /* ac-bd */
mpz_mul (b, b, c);
mpz_addmul (b, a, d); /* bc+ad */
mpz_swap (a, u);
ed += ec;
}
/* remove powers of two in (a,b) */
if (mpz_cmp_ui (a, 0) == 0)
{
w = mpz_scan1 (b, 0);
mpz_tdiv_q_2exp (b, b, w);
ed += w;
}
else if (mpz_cmp_ui (b, 0) == 0)
{
w = mpz_scan1 (a, 0);
mpz_tdiv_q_2exp (a, a, w);
ed += w;
}
else
{
w = mpz_scan1 (a, 0);
v = mpz_scan1 (b, 0);
if (v < w)
w = v;
mpz_tdiv_q_2exp (a, a, w);
mpz_tdiv_q_2exp (b, b, w);
ed += w;
}
if (mpz_sizeinbase (a, 2) > maxprec || mpz_sizeinbase (b, 2) > maxprec)
goto end;
}
/* now a+I*b = (c+I*d)^my */
while (ey-- > 0)
{
unsigned long sa, sb;
/* square a + I*b */
mpz_mul (u, a, b);
mpz_mul (a, a, a);
mpz_submul (a, b, b);
mpz_mul_2exp (b, u, 1);
ed *= 2;
/* divide by largest 2^n possible, to avoid many loops for e.g.,
(2+2*I)^16777216 */
sa = mpz_scan1 (a, 0);
sb = mpz_scan1 (b, 0);
sa = (sa <= sb) ? sa : sb;
mpz_tdiv_q_2exp (a, a, sa);
mpz_tdiv_q_2exp (b, b, sa);
ed += sa;
if (mpz_sizeinbase (a, 2) > maxprec || mpz_sizeinbase (b, 2) > maxprec)
goto end;
}
/* save emin, emax */
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_set_emin (mpfr_get_emin_min ());
mpfr_set_emax (mpfr_get_emax_max ());
ret = mpfr_set_z (MPC_RE(z), a, MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_z (MPC_IM(z), b, MPC_RND_IM(rnd)));
mpfr_mul_2si (MPC_RE(z), MPC_RE(z), ed, MPC_RND_RE(rnd));
mpfr_mul_2si (MPC_IM(z), MPC_IM(z), ed, MPC_RND_IM(rnd));
/* restore emin, emax */
mpfr_set_emin (emin);
mpfr_set_emax (emax);
end:
mpz_clear (my);
mpz_clear (a);
mpz_clear (b);
mpz_clear (c);
mpz_clear (d);
mpz_clear (u);
return ret;
}
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
}
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
}
static void
check_special_exprange (void)
{
int inexact, ov;
unsigned int eflags, gflags;
mpfr_t xi, xf, x;
mpfr_exp_t emax;
emax = mpfr_get_emax ();
mpfr_init2 (xi, 7);
mpfr_init2 (xf, 7);
mpfr_init2 (x, 8);
mpfr_set_str (x, "0.11111111", 2, MPFR_RNDN);
for (ov = 0; ov <= 1; ov++)
{
const char *s = ov ? "@Inf@" : "1";
if (ov)
set_emax (0);
mpfr_clear_flags ();
inexact = mpfr_modf (xi, xf, x, MPFR_RNDN);
gflags = __gmpfr_flags;
set_emax (emax);
if (MPFR_NOTZERO (xi) || MPFR_IS_NEG (xi) ||
mpfr_cmp_str1 (xf, s) != 0)
{
printf ("Error in check_special_exprange (ov = %d):"
" expected 0 and %s, got\n", ov, s);
mpfr_out_str (stdout, 2, 0, xi, MPFR_RNDN);
printf (" and ");
mpfr_out_str (stdout, 2, 0, xf, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (inexact != 4)
{
printf ("Bad inexact value in check_special_exprange (ov = %d):"
" expected 4, got %d\n", ov, inexact);
exit (1);
}
eflags = MPFR_FLAGS_INEXACT | (ov ? MPFR_FLAGS_OVERFLOW : 0);
if (gflags != eflags)
{
printf ("Bad flags in check_special_exprange (ov = %d):"
" expected %u, got %u\n", ov, eflags, gflags);
exit (1);
}
}
/* Test if an overflow occurs in mpfr_set for ope >= opq. */
mpfr_set_emax (MPFR_EMAX_MAX);
mpfr_set_inf (x, 1);
mpfr_nextbelow (x);
mpfr_clear_flags ();
inexact = mpfr_modf (xi, xf, x, MPFR_RNDN);
gflags = __gmpfr_flags;
if (mpfr_cmp_str1 (xi, "@Inf@") != 0 ||
MPFR_NOTZERO (xf) || MPFR_IS_NEG (xf))
{
printf ("Error in check_special_exprange:"
" expected 0 and @Inf@, got\n");
mpfr_out_str (stdout, 2, 0, xi, MPFR_RNDN);
printf (" and ");
mpfr_out_str (stdout, 2, 0, xf, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (inexact != 1)
{
printf ("Bad inexact value in check_special_exprange:"
" expected 1, got %d\n", inexact);
exit (1);
}
eflags = MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
if (gflags != eflags)
{
printf ("Bad flags in check_special_exprange:"
" expected %u, got %u\n", eflags, gflags);
exit (1);
}
set_emax (emax);
/* Test if an underflow occurs in the general case. TODO */
mpfr_clears (xi, xf, x, (mpfr_ptr) 0);
}
static void
special_overflow (void)
{
mpfr_t x, y;
mp_exp_t emin, emax;
int inex;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
set_emin (-125);
set_emax (128);
mpfr_init2 (x, 24);
mpfr_init2 (y, 24);
mpfr_set_str_binary (x, "0.101100100000000000110100E7");
mpfr_gamma (y, x, GMP_RNDN);
if (!mpfr_inf_p (y))
{
printf ("Overflow error.\n");
mpfr_dump (y);
exit (1);
}
/* problem mentioned by Kenneth Wilder, 18 Aug 2005 */
mpfr_set_prec (x, 29);
mpfr_set_prec (y, 29);
mpfr_set_str (x, "-200000000.5", 10, GMP_RNDN); /* exact */
mpfr_gamma (y, x, GMP_RNDN);
if (!(mpfr_zero_p (y) && MPFR_SIGN (y) < 0))
{
printf ("Error for gamma(-200000000.5)\n");
printf ("expected -0");
printf ("got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str (x, "-200000000.1", 10, GMP_RNDN);
mpfr_gamma (y, x, GMP_RNDN);
if (!(mpfr_zero_p (y) && MPFR_SIGN (y) < 0))
{
printf ("Error for gamma(-200000000.1), prec=53\n");
printf ("expected -0");
printf ("got ");
mpfr_dump (y);
exit (1);
}
/* another problem mentioned by Kenneth Wilder, 29 Aug 2005 */
mpfr_set_prec (x, 333);
mpfr_set_prec (y, 14);
mpfr_set_str (x, "-2.0000000000000000000000005", 10, GMP_RNDN);
mpfr_gamma (y, x, GMP_RNDN);
mpfr_set_prec (x, 14);
mpfr_set_str_binary (x, "-11010011110001E66");
if (mpfr_cmp (x, y))
{
printf ("Error for gamma(-2.0000000000000000000000005)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
/* another tests from Kenneth Wilder, 31 Aug 2005 */
set_emax (200);
set_emin (-200);
mpfr_set_prec (x, 38);
mpfr_set_prec (y, 54);
mpfr_set_str_binary (x, "0.11101111011100111101001001010110101001E-166");
mpfr_gamma (y, x, GMP_RNDN);
mpfr_set_prec (x, 54);
mpfr_set_str_binary (x, "0.100010001101100001110110001010111111010000100101011E167");
if (mpfr_cmp (x, y))
{
printf ("Error for gamma (test 1)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
set_emax (1000);
set_emin (-2000);
mpfr_set_prec (x, 38);
mpfr_set_prec (y, 71);
mpfr_set_str_binary (x, "10101011011100001111111000010111110010E-1034");
/* 184083777010*2^(-1034) */
mpfr_gamma (y, x, GMP_RNDN);
mpfr_set_prec (x, 71);
mpfr_set_str_binary (x, "10111111001000011110010001000000000000110011110000000011101011111111100E926");
/* 1762885132679550982140*2^926 */
if (mpfr_cmp (x, y))
{
printf ("Error for gamma (test 2)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 38);
mpfr_set_prec (y, 88);
mpfr_set_str_binary (x, "10111100111001010000100001100100100101E-104");
/* 202824096037*2^(-104) */
mpfr_gamma (y, x, GMP_RNDN);
mpfr_set_prec (x, 88);
mpfr_set_str_binary (x, "1010110101111000111010111100010110101010100110111000001011000111000011101100001101110010E-21");
/* 209715199999500283894743922*2^(-21) */
if (mpfr_cmp (x, y))
{
printf ("Error for gamma (test 3)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 171);
mpfr_set_prec (y, 38);
mpfr_set_str (x, "-2993155353253689176481146537402947624254601559176535", 10,
GMP_RNDN);
mpfr_div_2exp (x, x, 170, GMP_RNDN);
mpfr_gamma (y, x, GMP_RNDN);
mpfr_set_prec (x, 38);
mpfr_set_str (x, "201948391737", 10, GMP_RNDN);
mpfr_mul_2exp (x, x, 92, GMP_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error for gamma (test 5)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
set_emin (-500000);
mpfr_set_prec (x, 337);
mpfr_set_prec (y, 38);
mpfr_set_str (x, "-30000.000000000000000000000000000000000000000000001", 10,
GMP_RNDN);
mpfr_gamma (y, x, GMP_RNDN);
mpfr_set_prec (x, 38);
mpfr_set_str (x, "-3.623795987425E-121243", 10, GMP_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error for gamma (test 7)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
/* was producing infinite loop */
set_emin (emin);
mpfr_set_prec (x, 71);
mpfr_set_prec (y, 71);
mpfr_set_str (x, "-200000000.1", 10, GMP_RNDN);
mpfr_gamma (y, x, GMP_RNDN);
if (!(mpfr_zero_p (y) && MPFR_SIGN (y) < 0))
{
printf ("Error for gamma (test 8)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
set_emax (1073741823);
mpfr_set_prec (x, 29);
mpfr_set_prec (y, 29);
mpfr_set_str (x, "423786866", 10, GMP_RNDN);
mpfr_gamma (y, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for gamma(423786866)\n");
exit (1);
}
/* check exact result */
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 3, GMP_RNDN);
inex = mpfr_gamma (x, x, GMP_RNDN);
if (inex != 0 || mpfr_cmp_ui (x, 2) != 0)
{
printf ("Error for gamma(3)\n");
exit (1);
}
mpfr_set_emax (1024);
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "101010110100110011111010000110001000111100000110101E-43");
mpfr_gamma (x, x, GMP_RNDU);
mpfr_set_str_binary (y, "110000011110001000111110110101011110000100001111111E971");
if (mpfr_cmp (x, y) != 0)
{
printf ("Error for gamma(4)\n");
printf ("expected "); mpfr_dump (y);
printf ("got "); mpfr_dump (x);
exit (1);
}
mpfr_clear (y);
mpfr_clear (x);
set_emin (emin);
set_emax (emax);
}
static void
check_random (FILE *fout, int nb_tests)
{
int i;
mpfr_t x;
mp_rnd_t rnd;
char flag[] =
{
'-',
'+',
' ',
'#',
'0', /* no ambiguity: first zeros are flag zero*/
'\''
};
char specifier[] =
{
'a',
'b',
'e',
'f',
'g'
};
mp_exp_t old_emin, old_emax;
old_emin = mpfr_get_emin ();
old_emax = mpfr_get_emax ();
mpfr_init (x);
for (i = 0; i < nb_tests; ++i)
{
int ret;
int j, jmax;
int spec, prec;
#define FMT_SIZE 13
char fmt[FMT_SIZE]; /* at most something like "%-+ #0'.*R*f" */
char *ptr = fmt;
tests_default_random (x, 256, MPFR_EMIN_MIN, MPFR_EMAX_MAX);
rnd = RND_RAND ();
spec = (int) (randlimb () % 5);
jmax = (spec == 3 || spec == 4) ? 6 : 5; /* ' flag only with %f or %g */
/* advantage small precision */
prec = (int) (randlimb () % ((randlimb () % 2) ? 10 : prec_max_printf));
if (spec == 3
&& (mpfr_get_exp (x) > prec_max_printf
|| mpfr_get_exp (x) < -prec_max_printf))
/* change style 'f' to style 'e' when number x is large */
--spec;
*ptr++ = '%';
for (j = 0; j < jmax; j++)
{
if (randlimb () % 3 == 0)
*ptr++ = flag[j];
}
*ptr++ = '.';
*ptr++ = '*';
*ptr++ = 'R';
*ptr++ = '*';
*ptr++ = specifier[spec];
*ptr = '\0';
MPFR_ASSERTD (ptr - fmt < FMT_SIZE);
mpfr_fprintf (fout, "mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n",
fmt, prec, mpfr_print_rnd_mode (rnd), x);
ret = mpfr_fprintf (fout, fmt, prec, rnd, x);
if (ret == -1)
{
if (spec == 3
&& (MPFR_GET_EXP (x) > INT_MAX || MPFR_GET_EXP (x) < -INT_MAX))
/* normal failure: x is too large to be output with full precision */
{
mpfr_fprintf (fout, "too large !");
}
else
{
mpfr_printf ("Error in mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n",
fmt, prec, mpfr_print_rnd_mode (rnd), x);
exit (1);
}
}
mpfr_fprintf (fout, "\n");
}
mpfr_set_emin (old_emin);
mpfr_set_emax (old_emax);
mpfr_clear (x);
}