int
main (int argc, char **argv)
{
mpfr_t a;
mpfr_t b;
mpfr_t c;
char * lpsz;
mpfr_exp_t exp = 0;
int num = 100 * MPFR_VERSION_MAJOR + 10 * MPFR_VERSION_MINOR + MPFR_VERSION_PATCHLEVEL;
if (!(num >= 312 && strlen(mpfr_get_version()) > 0))
{
return 1;
}
mpfr_inits2(32, a, b, c, NULL);
mpfr_set_str(a, "3.1415926535897932384626433832795028841971693993751058209749445923078164062862", 10, MPFR_RNDN);
mpfr_set_si(b, 12345678);
mpfr_mul(c, a, b, MPFR_RNDN);
lpsz = mpfr_get_str(NULL, &exp, 10, 13, c, MPFR_RNDN);
if (strcmp(lpsz, "3878509131250") != 0)
{
return 1;
}
return 0;
}
static void
check_bug_base2k (void)
{
/*
* -2.63b22b55697e800000000000@130
* +-0.1001100011101100100010101101010101011010010111111010000000000000000000000000+00000000000000000000001E522
*/
mpfr_t xx, yy, zz;
char *s;
mpfr_exp_t e;
mpfr_init2 (xx, 107);
mpfr_init2 (yy, 79);
mpfr_init2 (zz, 99);
mpfr_set_str (xx, "-1.90e8c3e525d7c0000000000000@-18", 16, MPFR_RNDN);
mpfr_set_str (yy, "-2.63b22b55697e8000000@130", 16, MPFR_RNDN);
mpfr_add (zz, xx, yy, MPFR_RNDD);
s = mpfr_get_str (NULL, &e, 16, 0, zz, MPFR_RNDN);
if (strcmp (s, "-263b22b55697e8000000000008"))
{
printf ("Error for get_str base 16\n"
"Got %s expected -263b22b55697e8000000000008\n", s);
exit (1);
}
mpfr_free_str (s);
mpfr_clears (xx, yy, zz, (mpfr_ptr) 0);
}
/* From a bug reported by Joseph S. Myers
https://sympa.inria.fr/sympa/arc/mpfr/2012-08/msg00005.html */
static void
bug20120814 (void)
{
mpfr_exp_t emin = -30, e;
mpfr_t x, y;
int r;
char s[64], *p;
mpfr_init2 (x, 2);
mpfr_set_ui_2exp (x, 3, emin - 2, MPFR_RNDN);
mpfr_get_str (s + 1, &e, 10, 19, x, MPFR_RNDD);
s[0] = s[1];
s[1] = '.';
for (p = s; *p != 0; p++) ;
*p = 'e';
sprintf (p + 1, "%d", (int) e - 1);
mpfr_init2 (y, 4);
r = mpfr_strtofr (y, s, NULL, 0, MPFR_RNDN);
if (r <= 0 || ! mpfr_equal_p (x, y))
{
printf ("Error in bug20120814\n");
printf ("mpfr_strtofr failed on string \"%s\"\n", s);
printf ("Expected inex > 0 and y = 0.1100E%d\n", (int) emin);
printf ("Got inex = %-6d and y = ", r);
mpfr_dump (y);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
void StrPrinter::bvisit(const RealMPFR &x) {
mpfr_exp_t ex;
char* c = mpfr_get_str(nullptr, &ex, 10, 0, x.i.get_mpfr_t(), MPFR_RNDN);
std::ostringstream s;
str_ = std::string(c);
if (str_.at(0)== '-') {
s << '-';
str_ = str_.substr(1, str_.length() - 1);
}
if (ex > 6) {
s << str_.at(0) << '.' << str_.substr(1, str_.length() - 1) << 'e' << (ex - 1);
} else if (ex > 0) {
s << str_.substr(0, (unsigned long)ex) << ".";
s << str_.substr((unsigned long)ex, str_.length() - ex);
} else if (ex > -5) {
s << "0.";
for (int i = 0; i < -ex; ++i) {
s << '0';
}
s << str_;
} else {
s << str_.at(0) << '.' << str_.substr(1, str_.length() - 1) << 'e' << (ex - 1);
}
mpfr_free_str(c);
str_ = s.str();
}
void mexFunction( int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[] )
{
double *prec,*eout;
int mrows,ncols;
char *input_buf;
char *w1,*w2;
int buflen,status;
mpfr_t x,y,z;
mp_exp_t expptr;
/* Check for proper number of arguments. */
if(nrhs!=1) {
mexErrMsgTxt("1 inputs required.");
} else if(nlhs>2) {
mexErrMsgTxt("Too many output arguments");
}
/* The input must be a noncomplex scalar double.*/
mrows = mxGetM(prhs[0]);
ncols = mxGetN(prhs[0]);
if( !mxIsDouble(prhs[0]) || mxIsComplex(prhs[0]) ||
!(mrows==1 && ncols==1) ) {
mexErrMsgTxt("Input must be a noncomplex scalar double.");
}
/* Set precision and initialize mpfr variables */
prec = mxGetPr(prhs[0]);
mpfr_set_default_prec(*prec);
mpfr_init(x); mpfr_init(y); mpfr_init(z);
/* Mathematical operation */
mpfr_const_pi(z,GMP_RNDN);
/* Retrieve results */
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, z, GMP_RNDN);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[0] = mxCreateString(w1);
/* plhs[1] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eout=mxGetPr(plhs[1]); */
/* *eout=expptr; */
mpfr_clear(x);
mpfr_clear(y);
mpfr_clear(z);
mpfr_free_str(input_buf);
free(w1);
free(w2);
}
template <class Archive> void save(Archive & ar, const TruncatedBinomialDistribution::mpfr_class & number, const unsigned int version)
{
mp_exp_t exponent;
char* resultCStr = mpfr_get_str(NULL, &exponent, 10, 0, number.backend().data(), MPFR_RNDN);
std::string resultStr = resultCStr;
std::string outputString = (resultStr + "@" + boost::lexical_cast<std::string>(exponent - (mp_exp_t)resultStr.size()));
ar << outputString;
free(resultCStr);
}
void printReal(Real real){
#ifdef USE_MPFR
char* shadowValStr;
mpfr_exp_t shadowValExpt;
shadowValStr = mpfr_get_str(NULL, &shadowValExpt, 10, longprint_len, real->mpfr_val, MPFR_RNDN);
VG_(printf)("%c.%se%ld", shadowValStr[0], shadowValStr+1, shadowValExpt-1);
mpfr_free_str(shadowValStr);
#else
tl_assert2(0, "Can't print GMP vals!\n");
#endif
}
int
main (int argc, char *argv[])
{
unsigned long N = atoi (argv[1]), M;
mp_prec_t p;
mpfr_t i, j;
char *lo;
mp_exp_t exp_lo;
int st, st0;
fprintf (stderr, "Using GMP %s and MPFR %s\n", gmp_version, mpfr_version);
st = cputime ();
mpfr_init (i);
mpfr_init (j);
M = N;
do
{
M += 10;
mpfr_set_prec (i, 32);
mpfr_set_d (i, LOG2_10, GMP_RNDU);
mpfr_mul_ui (i, i, M, GMP_RNDU);
mpfr_add_ui (i, i, 3, GMP_RNDU);
p = mpfr_get_ui (i, GMP_RNDU);
fprintf (stderr, "Setting precision to %lu\n", p);
mpfr_set_prec (j, 2);
mpfr_set_prec (i, p);
mpfr_set_ui (j, 1, GMP_RNDN);
mpfr_exp (i, j, GMP_RNDN); /* i = exp(1) */
mpfr_set_prec (j, p);
mpfr_const_pi (j, GMP_RNDN);
mpfr_div (i, i, j, GMP_RNDN);
mpfr_sqrt (i, i, GMP_RNDN);
st0 = cputime ();
lo = mpfr_get_str (NULL, &exp_lo, 10, M, i, GMP_RNDN);
st0 = cputime () - st0;
}
while (can_round (lo, N, M) == 0);
lo[N] = '\0';
printf ("%s\n", lo);
mpfr_clear (i);
mpfr_clear (j);
fprintf (stderr, "Cputime: %dms (output %dms)\n", cputime () - st, st0);
return 0;
}
std::string real::get_string(int p) const
{
std::string string;
char *raw_string;
mpfr_exp_t exp;
if (mpfr_nan_p(r) != 0)
{
string = "nan";
}
else if (mpfr_inf_p(r) != 0)
{
if (mpfr_sgn(r) < 0)
{
string = "-inf";
}
else
{
string = "inf";
}
}
else
{
// Dynamically allocate a character array to hold the base-10
// representation of the real.
raw_string = new char[(int)mpfr_get_default_prec()];
mpfr_get_str(raw_string, &exp, 10, p, r, MPFR_RNDN);
string = std::string(raw_string);
if (mpfr_zero_p(r) == 0)
{
// The cast is to prevent a warning in case mpfr_exp_t is not
// defined as an int, but as a short or a long.
std::sprintf(raw_string, "%d", (int)(exp - 1));
}
else
{
std::sprintf(raw_string, "0");
}
if (string[0] == '-')
{
string = string.substr(0, 2) + std::string(".") + string.substr(2) + std::string("e") + std::string(raw_string);
}
else
{
string = string.substr(0, 1) + std::string(".") + string.substr(1) + std::string("e") + std::string(raw_string);
}
// Free the array.
delete[] raw_string;
}
return string;
}
size_t
mpfr_out_string (char *outstr, int base, size_t n_digits, mpfr_srcptr op, mp_rnd_t rnd_mode)
{
char *instr, *instr0;
size_t len;
mp_exp_t expo;
if (outstr == NULL)
return 0;
instr = mpfr_get_str (NULL, &expo, base, n_digits, op, rnd_mode);
instr0 = instr;
len = strlen (instr) + 1;
if (*instr == '-')
* outstr ++ = *instr++;
if (strcmp(instr, "@NaN@") == 0 || strcmp(instr, "@Inf@") == 0)
{
instr++;
* outstr ++ = *instr++;
* outstr ++ = *instr++;
* outstr ++ = *instr++;
mpfr_free_str(instr0);
return len-3;
}
/* Copy leading digit of mantissa into result. */
* outstr ++ = *instr++;
expo--; /* leading digit */
/* There seems to be a bug with the decimal point recognition
* in the old MPFR version that comes with GMP 4.1.4.
* With my locale (de_DE.UTF-8), conversion sets any fractional
* part of a number to 0. This problem disappears after installing
* GMP (without its internal MPFR) and then installing MPFR 2.2.0
* in a separate run.
*/
/* Insert a decimal point with the proper locale. */
* outstr ++ = localeconv()->decimal_point[0];
while (*instr)
* outstr ++ = *instr++;
mpfr_free_str(instr0);
/* Copy exponent into result. */
if (expo)
len += sprintf (outstr, (base <= 10 ? "E%ld" : "@%ld"), (long) expo);
return len;
}
uint64_t
Floating_hash (Floating* self)
{
if (CACHE(self)->hash) {
return CACHE(self)->hash;
}
mpfr_exp_t exp;
char* string = mpfr_get_str(NULL, &exp, 32, 0, *self->value, MPFR_RNDN);
size_t size = strlen(string);
CACHE(self)->hash = SIPHASH(RUNTIME_FOR(self), string, size + 1) ^ ((VALUE_TYPE_FLOATING << 4) ^ exp);
return CACHE(self)->hash;
}
static char *
get_pretty_str (const int base, const size_t n, mpfr_srcptr x, mpfr_rnd_t rnd)
{
mp_exp_t expo;
char *ugly;
char *pretty;
if (mpfr_zero_p (x))
return pretty_zero (x);
ugly = mpfr_get_str (NULL, &expo, base, n, x, rnd);
MPC_ASSERT (ugly != NULL);
pretty = prettify (ugly, expo, base, !mpfr_number_p (x));
mpfr_free_str (ugly);
return pretty;
}
static void
check3 (const char *d, mpfr_rnd_t rnd, const char *res)
{
mpfr_t x;
char *str;
mpfr_exp_t e;
mpfr_init2 (x, 53);
mpfr_set_str (x, d, 10, rnd);
str = mpfr_get_str (NULL, &e, 10, 5, x, rnd);
if (strcmp (str, res))
{
printf ("Error in mpfr_get_str for x=%s\n", d);
printf ("got %s instead of %s\n", str, res);
exit (1);
}
mpfr_clear (x);
mpfr_free_str (str);
}
void
real_from_mpfr (REAL_VALUE_TYPE *r, mpfr_srcptr m, tree type, mp_rnd_t rndmode)
{
/* We use a string as an intermediate type. */
char buf[128], *rstr;
mp_exp_t exp;
/* Take care of Infinity and NaN. */
if (mpfr_inf_p (m))
{
real_inf (r);
if (mpfr_sgn (m) < 0)
*r = real_value_negate (r);
return;
}
if (mpfr_nan_p (m))
{
real_nan (r, "", 1, TYPE_MODE (type));
return;
}
rstr = mpfr_get_str (NULL, &exp, 16, 0, m, rndmode);
/* The additional 12 chars add space for the sprintf below. This
leaves 6 digits for the exponent which is supposedly enough. */
gcc_assert (rstr != NULL && strlen (rstr) < sizeof (buf) - 12);
/* REAL_VALUE_ATOF expects the exponent for mantissa * 2**exp,
mpfr_get_str returns the exponent for mantissa * 16**exp, adjust
for that. */
exp *= 4;
if (rstr[0] == '-')
sprintf (buf, "-0x.%sp%d", &rstr[1], (int) exp);
else
sprintf (buf, "0x.%sp%d", rstr, (int) exp);
mpfr_free_str (rstr);
real_from_string (r, buf);
}
static void
check_reduced_exprange (void)
{
mpfr_t x;
char *s;
mpfr_exp_t emax, e;
emax = mpfr_get_emax ();
mpfr_init2 (x, 8);
mpfr_set_str (x, "0.11111111E0", 2, MPFR_RNDN);
set_emax (0);
s = mpfr_get_str (NULL, &e, 16, 0, x, MPFR_RNDN);
set_emax (emax);
if (strcmp (s, "ff0"))
{
printf ("Error for mpfr_get_str on 0.11111111E0 in base 16:\n"
"Got \"%s\" instead of \"ff0\".\n", s);
exit (1);
}
mpfr_free_str (s);
mpfr_clear (x);
}
hash_t
Floating_hash (Floating* self)
{
if (CACHE(self)->hash) {
return CACHE(self)->hash;
}
murmur3_t* state = MURMUR3_INIT(RUNTIME_FOR(self));
MURMUR3_UPDATE_WITH(state, VALUE_TYPE_FLOATING);
mpfr_exp_t exp;
char* string = mpfr_get_str(NULL, &exp, 32, 0, *self->value, MPFR_RNDN);
size_t size = strlen(string);
MURMUR3_UPDATE_WITH(state, exp);
MURMUR3_UPDATE(state, string, size);
CACHE(self)->hash = MURMUR3_FINAL(state);
free(string);
return CACHE(self)->hash;
}
int main()
{
mpfr_t b, p;
mpfr_init (p);
mpfr_init_set_str (b, "31", 10, GMP_RNDN);
mpfr_mul_ui (p, b, 75, GMP_RNDU); /* generate product */
char *str = new char[50]; // 50 should be enough
mp_exp_t exp;
str = mpfr_get_str(str, &exp, 10, 0, p, GMP_RNDU);
std::cout << str << " E " << exp << std::endl;
delete[] str;
#ifdef MPFR_VERSION
std::cout << "version=" << MPFR_VERSION_MAJOR << "."
<< MPFR_VERSION_MINOR << "."
<< MPFR_VERSION_PATCHLEVEL << std::endl;
#else
// MPFR versions < 2.2.0 did not have version strings
std::cout << "version=unknown" << std::endl;
#endif
return 0;
}
int
main (int argc, char *argv[])
{
mpfr_t x, y;
unsigned long k, bd, nc, i;
char *str, *str2;
mp_exp_t e;
int base, logbase, prec, baseprec, ret;
tests_start_mpfr ();
if (argc >= 2) /* tset_str <string> [<prec>] [<base>] */
{
prec = (argc >= 3) ? atoi (argv[2]) : 53;
base = (argc >= 4) ? atoi (argv[3]) : 2;
mpfr_init2 (x, prec);
mpfr_set_str (x, argv[1], base, GMP_RNDN);
mpfr_out_str (stdout, 10, 0, x, GMP_RNDN);
puts ("");
mpfr_clear (x);
return 0;
}
mpfr_init2 (x, 2);
nc = (argc > 1) ? atoi(argv[1]) : 53;
if (nc < 100)
nc = 100;
bd = randlimb () & 8;
str2 = str = (char*) (*__gmp_allocate_func) (nc * sizeof(char));
if (bd)
{
for(k = 1; k <= bd; k++)
*(str2++) = (randlimb () & 1) + '0';
}
else
*(str2++) = '0';
*(str2++) = '.';
for (k = 1; k < nc - 17 - bd; k++)
*(str2++) = '0' + (char) (randlimb () & 1);
*(str2++) = 'e';
sprintf (str2, "%d", (int) (randlimb () & INT_MAX) + INT_MIN/2);
mpfr_set_prec (x, nc + 10);
mpfr_set_str_binary (x, str);
mpfr_set_prec (x, 54);
mpfr_set_str_binary (x, "0.100100100110110101001010010101111000001011100100101010E-529");
mpfr_init2 (y, 54);
mpfr_set_str (y, "4.936a52bc17254@-133", 16, GMP_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (1a):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str_binary (x, "0.111111101101110010111010100110000111011001010100001101E-529");
mpfr_set_str (y, "0.fedcba98765434P-529", 16, GMP_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (1b):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
(*__gmp_free_func) (str, nc * sizeof(char));
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "+110101100.01010000101101000000100111001000101011101110E00");
mpfr_set_str_binary (x, "1.0");
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in mpfr_set_str_binary for s=1.0\n");
mpfr_clear(x);
mpfr_clear(y);
exit(1);
}
mpfr_set_str_binary (x, "+0000");
mpfr_set_str_binary (x, "+0000E0");
mpfr_set_str_binary (x, "0000E0");
if (mpfr_cmp_ui (x, 0))
{
printf ("Error in mpfr_set_str_binary for s=0.0\n");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (x, "+243495834958.53452345E1", 10, GMP_RNDN);
mpfr_set_str (x, "9007199254740993", 10, GMP_RNDN);
mpfr_set_str (x, "9007199254740992", 10, GMP_RNDU);
mpfr_set_str (x, "9007199254740992", 10, GMP_RNDD);
mpfr_set_str (x, "9007199254740992", 10, GMP_RNDZ);
/* check a random number printed and read is not modified */
prec = 53;
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
for (i=0;i<N;i++)
{
mpfr_random (x);
k = RND_RAND ();
logbase = (randlimb () % 5) + 1;
base = 1 << logbase;
/* Warning: the number of bits needed to print exactly a number of
'prec' bits in base 2^logbase may be greater than ceil(prec/logbase),
for example 0.11E-1 in base 2 cannot be written exactly with only
one digit in base 4 */
if (base == 2)
baseprec = prec;
else
baseprec = 1 + (prec - 2 + logbase) / logbase;
str = mpfr_get_str (NULL, &e, base, baseprec, x, (mp_rnd_t) k);
mpfr_set_str (y, str, base, (mp_rnd_t) k);
MPFR_EXP(y) += logbase * (e - strlen (str));
if (mpfr_cmp (x, y))
{
printf ("mpfr_set_str o mpfr_get_str <> id for rnd_mode=%s\n",
mpfr_print_rnd_mode ((mp_rnd_t) k));
printf ("x=");
mpfr_print_binary (x);
puts ("");
printf ("s=%s, exp=%d, base=%d\n", str, (int) e, base);
printf ("y=");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
(*__gmp_free_func) (str, strlen (str) + 1);
}
for (i = 2; i <= 36; i++)
{
if (mpfr_set_str (x, "@NaN@(garbage)", i, GMP_RNDN) != 0 ||
!mpfr_nan_p(x))
{
printf ("mpfr_set_str failed on @NaN@(garbage)\n");
exit (1);
}
/*
if (mpfr_set_str (x, "@Inf@garbage", i, GMP_RNDN) != 0 ||
!mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
{
printf ("mpfr_set_str failed on @Inf@garbage\n");
exit (1);
}
if (mpfr_set_str (x, "-@Inf@garbage", i, GMP_RNDN) != 0 ||
!mpfr_inf_p(x) || MPFR_SIGN(x) > 0)
{
printf ("mpfr_set_str failed on -@Inf@garbage\n");
exit (1);
}
if (mpfr_set_str (x, "+@Inf@garbage", i, GMP_RNDN) != 0 ||
!mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
{
printf ("mpfr_set_str failed on +@Inf@garbage\n");
exit (1);
}
*/
if (i > 16)
continue;
if (mpfr_set_str (x, "NaN", i, GMP_RNDN) != 0 ||
!mpfr_nan_p(x))
{
printf ("mpfr_set_str failed on NaN\n");
exit (1);
}
if (mpfr_set_str (x, "Inf", i, GMP_RNDN) != 0 ||
!mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
{
printf ("mpfr_set_str failed on Inf\n");
exit (1);
}
if (mpfr_set_str (x, "-Inf", i, GMP_RNDN) != 0 ||
!mpfr_inf_p(x) || MPFR_SIGN(x) > 0)
{
printf ("mpfr_set_str failed on -Inf\n");
exit (1);
}
if (mpfr_set_str (x, "+Inf", i, GMP_RNDN) != 0 ||
!mpfr_inf_p(x) || MPFR_SIGN(x) < 0)
{
printf ("mpfr_set_str failed on +Inf\n");
exit (1);
}
}
/* check that mpfr_set_str works for uppercase letters too */
mpfr_set_prec (x, 10);
mpfr_set_str (x, "B", 16, GMP_RNDN);
if (mpfr_cmp_ui (x, 11) != 0)
{
printf ("mpfr_set_str does not work for uppercase letters\n");
exit (1);
}
/* start of tests added by Alain Delplanque */
/* in this example an overflow can occur */
mpfr_set_prec (x, 64);
mpfr_set_prec (y, 64);
mpfr_set_str_binary (x, "1.0E-532");
mpfr_set_str (y, "0.71128279983522479470@-160", 10, GMP_RNDU);
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (2):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
/* in this example, I think there was a pb in the old function :
result of mpfr_set_str_old for the same number , but with more
precision is: 1.111111111110000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100111000100001100000010101100111010e184
this result is the same as mpfr_set_str */
mpfr_set_prec (x, 64);
mpfr_set_prec (y, 64);
mpfr_set_str_binary (x, "1.111111111110000000000000000111111111111111111111111110000000001E184");
mpfr_set_str (y, "0.jo08hg31hc5mmpj5mjjmgn55p2h35g@39", 27, GMP_RNDU);
/* y = 49027884868983130654865109690613178467841148597221480052 */
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (3):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
/* not exact rounding in mpfr_set_str
same number with more precision is : 1.111111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011011111101000001101110110010101101000010100110011101110010001110e195
this result is the same as mpfr_set_str */
/* problem was : can_round was call with GMP_RNDN round mode,
so can_round use an error : 1/2 * 2^err * ulp(y)
instead of 2^err * ulp(y)
I have increase err by 1 */
mpfr_set_prec (x, 64); /* it was round down instead of up */
mpfr_set_prec (y, 64);
mpfr_set_str_binary (x, "1.111111111111111111111111111000000000000000000000000000000000001e195");
mpfr_set_str (y, "0.6e23ekb6acgh96abk10b6c9f2ka16i@45", 21, GMP_RNDU);
/* y = 100433627392042473064661483711179345482301462325708736552078 */
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (4):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
/* may be an error in mpfr_set_str_old
with more precision : 1.111111100000001111110000000000011111011111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111110111101010001110111011000010111001011100110110e180 */
mpfr_set_prec (x, 64); /* it was round down instead of up */
mpfr_set_prec (y, 64);
mpfr_set_str_binary (x, "1.111111100000001111110000000000011111011111111111111111111111111e180");
mpfr_set_str (y, "0.10j8j2k82ehahha56390df0a1de030@41", 23, GMP_RNDZ);
/* y = 3053110535624388280648330929253842828159081875986159414 */
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (5):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_prec (x, 64);
mpfr_set_prec (y, 64);
mpfr_set_str (y, "0.jrchfhpp9en7hidqm9bmcofid9q3jg@39", 28, GMP_RNDU);
/* y = 196159429139499688661464718784226062699788036696626429952 */
mpfr_set_str_binary (x, "0.1111111111111111111111111111111000000000000011100000001111100001E187");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (6):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_prec (x, 64);
mpfr_set_prec (y, 64);
mpfr_set_str (y, "0.h148m5ld5cf8gk1kd70b6ege92g6ba@47", 24, GMP_RNDZ);
/* y = 52652933527468502324759448399183654588831274530295083078827114496 */
mpfr_set_str_binary (x, "0.1111111111111100000000001000000000000000000011111111111111101111E215");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (7):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
/* worst cases for rounding to nearest in double precision */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str (y, "5e125", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10111101000101110110011000100000101001010000000111111E418");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (8):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "69e267", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10000101101111100101101100000110010011001010011011010E894");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (9):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "623e100", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10110010000001010011000101111001110101000001111011111E342");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (10):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "3571e263", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10110001001100100010011000110000111010100000110101010E886");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (11):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "75569e-254", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10101101001000110001011011001000111000110101010110011E-827");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (12):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "920657e-23", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10101001110101001100110000101110110111101111001101100E-56");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (13):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "9210917e80", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.11101101000100011001000110100011111100110000000110010E289");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (14):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "87575437e-309", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.11110000001110011001000000110000000100000010101101100E-1000");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (15):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "245540327e122", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10001101101100010001100011110000110001100010111001011E434");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (16):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "491080654e122", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10001101101100010001100011110000110001100010111001011E435");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (17):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
mpfr_set_str (y, "83356057653e193", 10, GMP_RNDN);
mpfr_set_str_binary (x, "0.10101010001001110011011011010111011100010101000011000E678");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_set_str (18):\n");
mpfr_print_binary (x);
puts ("");
mpfr_print_binary (y);
puts ("");
mpfr_clear (x);
mpfr_clear (y);
exit (1);
}
CHECK53(y, "83356057653e193", GMP_RNDN, x,
"0.10101010001001110011011011010111011100010101000011000E678",
18);
CHECK53(y, "619534293513e124", GMP_RNDN, x,
"0.10001000011000010000000110000001111111110000011110001e452",
19);
CHECK53(y, "3142213164987e-294", GMP_RNDN, x,
"0.11101001101000000100111011111101111001010001001101111e-935",
20);
CHECK53(y, "36167929443327e-159", GMP_RNDN, x,
"0.11100111001110111110000101011001100110010100011111100e-483",
21);
CHECK53(y, "904198236083175e-161", GMP_RNDN, x,
"0.11100111001110111110000101011001100110010100011111100e-485",
22);
CHECK53(y, "3743626360493413e-165", GMP_RNDN, x,
"0.11000100000100011101001010111101011011011111011111001e-496",
23);
CHECK53(y, "94080055902682397e-242", GMP_RNDN, x,
"0.10110010010011000000111100011100111100110011011001010e-747",
24);
CHECK53(y, "7e-303", GMP_RNDD, x,
"0.10011001100111001000100110001110001000110111110001011e-1003",
25);
CHECK53(y, "7e-303", GMP_RNDU, x,
"0.10011001100111001000100110001110001000110111110001100e-1003",
26);
CHECK53(y, "93e-234", GMP_RNDD, x,
"0.10010011110110010111001001111001000010000000001110101E-770",
27);
CHECK53(y, "93e-234", GMP_RNDU, x,
"0.10010011110110010111001001111001000010000000001110110E-770",
28);
CHECK53(y, "755e174", GMP_RNDD, x,
"0.10111110110010011000110010011111101111000111111000101E588",
29);
CHECK53(y, "755e174", GMP_RNDU, x,
"0.10111110110010011000110010011111101111000111111000110E588",
30);
CHECK53(y, "8699e-276", GMP_RNDD, x,
"0.10010110100101101111100100100011011101100110100101100E-903",
31);
CHECK53(y, "8699e-276", GMP_RNDU, x,
"0.10010110100101101111100100100011011101100110100101101E-903",
32);
CHECK53(y, "82081e41", GMP_RNDD, x,
"0.10111000000010000010111011111001111010100011111001011E153",
33);
CHECK53(y, "82081e41", GMP_RNDU, x,
"0.10111000000010000010111011111001111010100011111001100E153",
34);
CHECK53(y, "584169e229", GMP_RNDD, x,
"0.11101011001010111000001011001110111000111100110101010E780",
35);
CHECK53(y, "584169e229", GMP_RNDU, x,
"0.11101011001010111000001011001110111000111100110101011E780",
36);
CHECK53(y, "5783893e-128", GMP_RNDD, x,
"0.10011000111100000110011110000101100111110011101110100E-402",
37);
CHECK53(y, "5783893e-128", GMP_RNDU, x,
"0.10011000111100000110011110000101100111110011101110101E-402",
38);
CHECK53(y, "87575437e-310", GMP_RNDD, x,
"0.11000000001011100000110011110011010000000010001010110E-1003",
39);
CHECK53(y, "87575437e-310", GMP_RNDU, x,
"0.11000000001011100000110011110011010000000010001010111E-1003",
40);
CHECK53(y, "245540327e121", GMP_RNDD, x,
"0.11100010101101001111010010110100011100000100101000100E430",
41);
CHECK53(y, "245540327e121", GMP_RNDU, x,
"0.11100010101101001111010010110100011100000100101000101E430",
42);
CHECK53(y, "9078555839e-109", GMP_RNDD, x,
"0.11111110001010111010110000110011100110001010011101101E-329",
43);
CHECK53(y, "9078555839e-109", GMP_RNDU, x,
"0.11111110001010111010110000110011100110001010011101110E-329",
44);
CHECK53(y, "42333842451e201", GMP_RNDD, x,
"0.10000000110001001101000100110110111110101011101011111E704",
45);
CHECK53(y, "42333842451e201", GMP_RNDU, x,
"0.10000000110001001101000100110110111110101011101100000E704",
46);
CHECK53(y, "778380362293e218", GMP_RNDD, x,
"0.11001101010111000001001100001100110010000001010010010E764",
47);
CHECK53(y, "778380362293e218", GMP_RNDU, x,
"0.11001101010111000001001100001100110010000001010010011E764",
48);
CHECK53(y, "7812878489261e-179", GMP_RNDD, x,
"0.10010011011011010111001111011101111101101101001110100E-551",
49);
CHECK53(y, "7812878489261e-179", GMP_RNDU, x,
"0.10010011011011010111001111011101111101101101001110101E-551",
50);
CHECK53(y, "77003665618895e-73", GMP_RNDD, x,
"0.11000101111110111111001111111101001101111000000101001E-196",
51);
CHECK53(y, "77003665618895e-73", GMP_RNDU, x,
"0.11000101111110111111001111111101001101111000000101010E-196",
52);
CHECK53(y, "834735494917063e-300", GMP_RNDD, x,
"0.11111110001101100001001101111100010011001110111010001E-947",
53);
CHECK53(y, "834735494917063e-300", GMP_RNDU, x,
"0.11111110001101100001001101111100010011001110111010010E-947",
54);
CHECK53(y, "6182410494241627e-119", GMP_RNDD, x,
"0.10001101110010110010001011000010001000101110100000111E-342",
55);
CHECK53(y, "6182410494241627e-119", GMP_RNDU, x,
"0.10001101110010110010001011000010001000101110100001000E-342",
56);
CHECK53(y, "26153245263757307e49", GMP_RNDD, x,
"0.10011110111100000000001011011110101100010000011011110E218",
57);
CHECK53(y, "26153245263757307e49", GMP_RNDU, x,
"0.10011110111100000000001011011110101100010000011011111E218",
58);
/* to check this problem : I convert limb (10--0 or 101--1) into base b
with more than mp_bits_per_limb digits,
so when convert into base 2 I should have
the limb that I have choose */
/* this use mpfr_get_str */
{
size_t nb_digit = mp_bits_per_limb;
mp_limb_t check_limb[2] = {MPFR_LIMB_HIGHBIT, ~(MPFR_LIMB_HIGHBIT >> 1)};
int base[3] = {10, 16, 19};
mp_rnd_t rnd[3] = {GMP_RNDU, GMP_RNDN, GMP_RNDD};
int cbase, climb, crnd;
char *str;
mpfr_set_prec (x, mp_bits_per_limb); /* x and y have only one limb */
mpfr_set_prec (y, mp_bits_per_limb);
str = (char*) (*__gmp_allocate_func) (N + 20);
mpfr_set_ui (x, 1, GMP_RNDN); /* ensures that x is not NaN or Inf */
for (; nb_digit < N; nb_digit *= 10)
for (cbase = 0; cbase < 3; cbase++)
for (climb = 0; climb < 2; climb++)
for (crnd = 0; crnd < 3; crnd++)
{
char *str1;
mp_exp_t exp;
*(MPFR_MANT(x)) = check_limb[climb];
MPFR_EXP(x) = 0;
mpfr_get_str (str + 2, &exp, base[cbase],
nb_digit, x, rnd[crnd]);
str[0] = '-';
str[(str[2] == '-')] = '0';
str[(str[2] == '-') + 1] = '.';
for (str1 = str; *str1 != 0; str1++)
;
sprintf (str1, "@%i", (int) exp);
mpfr_set_str (y, str, base[cbase], rnd[2 - crnd]);
if (mpfr_cmp (x, y) != 0)
{
printf ("Error in mpfr_set_str for nb_digit=%u, base=%d, "
"rnd=%s:\n", (unsigned int) nb_digit, base[cbase],
mpfr_print_rnd_mode (rnd[crnd]));
printf ("instead of: ");
mpfr_print_binary (x);
puts ("");
printf ("return : ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
}
(*__gmp_free_func) (str, N + 20);
}
/* end of tests added by Alain Delplanque */
/* check that flags are correctly cleared */
mpfr_set_nan (x);
mpfr_set_str (x, "+0.0", 10, GMP_RNDN);
if (!mpfr_number_p(x) || mpfr_cmp_ui (x, 0) != 0 || mpfr_sgn (x) < 0)
{
printf ("x <- +0.0 failed after x=NaN\n");
exit (1);
}
mpfr_set_str (x, "-0.0", 10, GMP_RNDN);
if (!mpfr_number_p(x) || mpfr_cmp_ui (x, 0) != 0 || mpfr_sgn (x) > 0)
{
printf ("x <- -0.0 failed after x=NaN\n");
exit (1);
}
/* check invalid input */
ret = mpfr_set_str (x, "1E10toto", 10, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
ret = mpfr_set_str (x, "1p10toto", 16, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
ret = mpfr_set_str (x, "", 16, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
ret = mpfr_set_str (x, "+", 16, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
ret = mpfr_set_str (x, "-", 16, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
ret = mpfr_set_str (x, "this_is_an_invalid_number_in_base_36", 36, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
ret = mpfr_set_str (x, "1.2.3", 10, GMP_RNDN);
MPFR_ASSERTN (ret == -1);
mpfr_set_prec (x, 135);
ret = mpfr_set_str (x, "thisisavalidnumberinbase36", 36, GMP_RNDN);
mpfr_set_prec (y, 135);
mpfr_set_str (y, "23833565676460972739462619524519814462546", 10, GMP_RNDN);
MPFR_ASSERTN (mpfr_cmp (x, y) == 0 && ret == 0);
/* coverage test for set_str_binary */
mpfr_set_str_binary (x, "NaN");
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_str_binary (x, "Inf");
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_str_binary (x, "+Inf");
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_str_binary (x, "-Inf");
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_prec (x, 3);
mpfr_set_str_binary (x, "0.01E2");
MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
mpfr_set_str_binary (x, "-0.01E2");
MPFR_ASSERTN(mpfr_cmp_si (x, -1) == 0);
mpfr_clear (x);
mpfr_clear (y);
check_underflow ();
tests_end_mpfr ();
return 0;
}
size_t
mpfr_out_str (FILE *stream, int base, size_t n_digits, mpfr_srcptr op,
mp_rnd_t rnd_mode)
{
char *s, *s0;
size_t l;
mp_exp_t e;
/* when stream=NULL, output to stdout */
if (stream == NULL)
stream = stdout;
if (MPFR_IS_NAN(op))
{
fprintf (stream, "@NaN@");
return 3;
}
if (MPFR_IS_INF(op))
{
if (MPFR_SIGN(op) > 0)
{
fprintf (stream, "@Inf@");
return 3;
}
else
{
fprintf (stream, "-@Inf@");
return 4;
}
}
if (MPFR_IS_ZERO(op))
{
if (MPFR_SIGN(op) > 0)
{
fprintf(stream, "0");
return 1;
}
else
{
fprintf(stream, "-0");
return 2;
}
}
s = mpfr_get_str (NULL, &e, base, n_digits, op, rnd_mode);
s0 = s;
/* for op=3.1416 we have s = "31416" and e = 1 */
l = strlen (s) + 1; /* size of allocated block returned by mpfr_get_str
- may be incorrect, as only an upper bound? */
if (*s == '-')
fputc (*s++, stream);
/* outputs mantissa */
fputc (*s++, stream); e--; /* leading digit */
fputc ('.', stream); /* decimal point */
fputs (s, stream); /* rest of mantissa */
(*__gmp_free_func) (s0, l);
/* outputs exponent */
if (e)
{
MPFR_ASSERTN(e >= LONG_MIN);
MPFR_ASSERTN(e <= LONG_MAX);
l += fprintf (stream, (base <= 10 ? "e%ld" : "@%ld"), (long) e);
}
return l;
}
/* Convert R "mpfr" object (list of "mpfr1") to R "character" vector,
* using precision 'prec' which can be NA/NULL in which case
* "full precision" (as long as necessary) is used : */
SEXP mpfr2str(SEXP x, SEXP digits, SEXP base) {
int n = length(x), i;
int n_dig = isNull(digits) ? 0 : asInteger(digits);
int dig_n_max = -1;
SEXP val = PROTECT(allocVector(VECSXP, 4)),
nms, str, exp, fini, zero;
int *i_exp, *is_fin, *is_0;
int B = asInteger(base); // = base for output
double p_fact = (B == 2) ? 1. : log(B) / M_LN2;
char *ch = NULL;
mpfr_t R_i;
if(n_dig < 0)
error("'digits' must be NULL or integer >= 0");
/* be "overprotective" for now ... */
SET_VECTOR_ELT(val, 0, str = PROTECT(allocVector(STRSXP, n)));
SET_VECTOR_ELT(val, 1, exp = PROTECT(allocVector(INTSXP, n)));
SET_VECTOR_ELT(val, 2, fini= PROTECT(allocVector(LGLSXP, n)));
SET_VECTOR_ELT(val, 3, zero= PROTECT(allocVector(LGLSXP, n)));
nms = PROTECT(allocVector(STRSXP, 4));
SET_STRING_ELT(nms, 0, mkChar("str"));
SET_STRING_ELT(nms, 1, mkChar("exp"));
SET_STRING_ELT(nms, 2, mkChar("finite"));
SET_STRING_ELT(nms, 3, mkChar("is.0"));
setAttrib(val, R_NamesSymbol, nms);
i_exp = INTEGER(exp);
is_fin= LOGICAL(fini);
is_0 = LOGICAL(zero);
mpfr_init(R_i); /* with default precision */
for(i=0; i < n; i++) {
mpfr_exp_t exp = (mpfr_exp_t) 0;
mpfr_exp_t *exp_ptr = &exp;
int dig_needed;
R_asMPFR(VECTOR_ELT(x, i), R_i);
#ifdef __Rmpfr_FIRST_TRY_FAILS__
/* Observing memory problems, e.g., see ../tests/00-bug.R.~3~
* Originally hoped it was solvable via R_alloc() etc, but it seems the problem is
* deeper and I currently suspect a problem/bug in MPFR library's mpfr_get_str(..) */
ch = mpfr_get_str(NULL, exp_ptr, B,
(size_t) n_dig, R_i, MPFR_RNDN);
#else
if(n_dig) {/* use it as desired precision */
dig_needed = n_dig;
} else { /* n_dig = 0 --> string will use "enough" digits */
dig_needed = p_fact * (int)R_i->_mpfr_prec;
}
if (i == 0) { /* first time */
dig_n_max = dig_needed;
ch = (char *) R_alloc(dig_needed + 2, sizeof(char));
}
else if(!n_dig && dig_needed > dig_n_max) {
ch = (char *) S_realloc(ch, dig_needed + 2, dig_n_max + 2,
sizeof(char));
dig_n_max = dig_needed;
}
/* char * mpfr_get_str (char *STR, mpfr_exp_t *EXPPTR, int B,
* size_t N, mpfr_t OP, mpfr_rnd_t RND) */
mpfr_get_str(ch, exp_ptr, B,
(size_t) n_dig, R_i, MPFR_RNDN);
#endif
SET_STRING_ELT(str, i, mkChar(ch));
i_exp[i] = (int) exp_ptr[0];
is_fin[i]= mpfr_number_p(R_i);
is_0 [i] = mpfr_zero_p(R_i);
#ifdef __Rmpfr_FIRST_TRY_FAILS__
mpfr_free_str(ch);
#endif
}
mpfr_clear (R_i);
mpfr_free_cache();
UNPROTECT(6);
return val;
}
size_t
mpfr_out_str (FILE *stream, int base, size_t n_digits, mpfr_srcptr op,
mpfr_rnd_t rnd_mode)
{
char *s, *s0;
size_t l;
mpfr_exp_t e;
int err;
MPFR_ASSERTN (base >= 2 && base <= 62);
/* when stream=NULL, output to stdout */
if (stream == NULL)
stream = stdout;
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (op)))
{
if (MPFR_IS_NAN (op))
OUT_STR_RET ("@NaN@");
else if (MPFR_IS_INF (op))
OUT_STR_RET (MPFR_IS_POS (op) ? "@Inf@" : "-@Inf@");
else
{
MPFR_ASSERTD (MPFR_IS_ZERO (op));
OUT_STR_RET (MPFR_IS_POS (op) ? "0" : "-0");
}
}
s = mpfr_get_str (NULL, &e, base, n_digits, op, rnd_mode);
s0 = s;
/* for op=3.1416 we have s = "31416" and e = 1 */
l = strlen (s) + 1; /* size of allocated block returned by mpfr_get_str
- may be incorrect, as only an upper bound? */
/* outputs possible sign and significand */
err = (*s == '-' && fputc (*s++, stream) == EOF)
|| fputc (*s++, stream) == EOF /* leading digit */
|| fputc ((unsigned char) MPFR_DECIMAL_POINT, stream) == EOF
|| fputs (s, stream) == EOF; /* trailing significand */
(*__gmp_free_func) (s0, l);
if (MPFR_UNLIKELY (err))
return 0;
e--; /* due to the leading digit */
/* outputs exponent */
if (e)
{
int r;
MPFR_ASSERTN(e >= LONG_MIN);
MPFR_ASSERTN(e <= LONG_MAX);
r = fprintf (stream, (base <= 10 ? "e%ld" : "@%ld"), (long) e);
if (MPFR_UNLIKELY (r < 0))
return 0;
l += r;
}
return l;
}
static void
test_round_near_x (void)
{
mpfr_t x, y, z, eps;
mpfr_exp_t e;
int failures = 0, mx, neg, err, dir, r, inex, inex2;
char buffer[7], *p;
mpfr_inits (x, y, z, eps, (mpfr_ptr) 0);
mpfr_set_prec (x, 5);
mpfr_set_prec (y, 3);
mpfr_set_prec (z, 3);
mpfr_set_prec (eps, 2);
mpfr_set_ui_2exp (eps, 1, -32, MPFR_RNDN);
for (mx = 16; mx < 32; mx++)
{
mpfr_set_ui_2exp (x, mx, -2, MPFR_RNDN);
for (p = buffer, neg = 0;
neg <= 1;
mpfr_neg (x, x, MPFR_RNDN), p++, neg++)
for (err = 2; err <= 6; err++)
for (dir = 0; dir <= 1; dir++)
RND_LOOP(r)
{
inex = mpfr_round_near_x (y, x, err, dir, (mpfr_rnd_t) r);
if (inex == 0 && err < 6)
{
/* The test is more restrictive than necessary.
So, no failure in this case. */
continue;
}
inex2 = ((dir ^ neg) ? mpfr_add : mpfr_sub)
(z, x, eps, (mpfr_rnd_t) r);
if (inex * inex2 <= 0)
printf ("Bad return value (%d instead of %d) for:\n",
inex, inex2);
else if (mpfr_equal_p (y, z))
continue; /* correct inex and y */
else
{
printf ("Bad MPFR value (should have got ");
mpfr_out_str (stdout, 2, 3, z, MPFR_RNDZ);
printf (") for:\n");
}
if (!mpfr_get_str (buffer, &e, 2, 5, x, MPFR_RNDZ) || e != 3)
{
printf ("mpfr_get_str failed in test_round_near_x\n");
exit (1);
}
printf ("x = %c%c%c%c.%c%c, ", neg ? '-' : '+',
p[0], p[1], p[2], p[3], p[4]);
printf ("err = %d, dir = %d, r = %s --> inex = %2d",
err, dir, mpfr_print_rnd_mode ((mpfr_rnd_t) r), inex);
if (inex != 0)
{
printf (", y = ");
mpfr_out_str (stdout, 2, 3, y, MPFR_RNDZ);
}
printf ("\n");
if (inex == 0)
printf ("Rounding was possible!\n");
if (++failures == 10) /* show at most 10 failures */
exit (1);
}
}
if (failures)
exit (1);
mpfr_clears (x, y, z, eps, (mpfr_ptr) 0);
}
void mexFunction( int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[] )
{
double *prec,*eoutr,*eouti;
int mrows,ncols;
char *input_buf;
char *w1,*w2;
int buflen,status;
mpfr_t xr,xi,yr,yi,zr,zi,temp,temp1;
mp_exp_t expptr;
/* Check for proper number of arguments. */
if(nrhs!=5) {
mexErrMsgTxt("5 inputs required.");
} else if(nlhs>4) {
mexErrMsgTxt("Too many output arguments");
}
/* The input must be a noncomplex scalar double.*/
mrows = mxGetM(prhs[0]);
ncols = mxGetN(prhs[0]);
if( !mxIsDouble(prhs[0]) || mxIsComplex(prhs[0]) ||
!(mrows==1 && ncols==1) ) {
mexErrMsgTxt("Input must be a noncomplex scalar double.");
}
/* Set precision and initialize mpfr variables */
prec = mxGetPr(prhs[0]);
mpfr_set_default_prec(*prec);
mpfr_init(xr); mpfr_init(xi);
mpfr_init(yr); mpfr_init(yi);
mpfr_init(zr); mpfr_init(zi);
mpfr_init(temp); mpfr_init(temp1);
/* Read the input strings into mpfr x real */
buflen = (mxGetM(prhs[1]) * mxGetN(prhs[1])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[1], input_buf, buflen);
mpfr_set_str(xr,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr x imag */
buflen = (mxGetM(prhs[2]) * mxGetN(prhs[2])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[2], input_buf, buflen);
mpfr_set_str(xi,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr y real */
buflen = (mxGetM(prhs[3]) * mxGetN(prhs[3])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[3], input_buf, buflen);
mpfr_set_str(yr,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr y imag */
buflen = (mxGetM(prhs[4]) * mxGetN(prhs[4])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[4], input_buf, buflen);
mpfr_set_str(yi,input_buf,10,GMP_RNDN);
/* Mathematical operation */
/* denominator */
mpfr_mul(temp,yr,yr,GMP_RNDN);
mpfr_mul(temp1,yi,yi,GMP_RNDN);
mpfr_add(temp,temp,temp1,GMP_RNDN);
/* real part */
mpfr_mul(temp1,xr,yr,GMP_RNDN);
mpfr_mul(zr,xi,yi,GMP_RNDN);
mpfr_add(zr,temp1,zr,GMP_RNDN);
/* imag part */
mpfr_mul(temp1,xi,yr,GMP_RNDN);
mpfr_mul(zi,xr,yi,GMP_RNDN);
mpfr_sub(zi,temp1,zi,GMP_RNDN);
/* divide by denominator */
mpfr_div(zr,zr,temp,GMP_RNDN);
mpfr_div(zi,zi,temp,GMP_RNDN);
/* Retrieve results */
mxFree(input_buf);
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, zr, GMP_RNDN);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[0] = mxCreateString(w1);
/* plhs[1] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eoutr=mxGetPr(plhs[1]); */
/* *eoutr=expptr; */
mpfr_free_str(input_buf);
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, zi, GMP_RNDN);
free(w1);
free(w2);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[1] = mxCreateString(w1);
/* plhs[3] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eouti=mxGetPr(plhs[3]); */
/* *eouti=expptr; */
mpfr_clear(xr); mpfr_clear(xi);
mpfr_clear(yr); mpfr_clear(yi);
mpfr_clear(zr); mpfr_clear(zi);
mpfr_clear(temp); mpfr_clear(temp1);
mpfr_free_str(input_buf);
free(w1);
free(w2);
}
void qore_number_private::getAsString(QoreString& str, bool round) const {
// first check for zero
if (zero()) {
str.concat("0");
return;
}
mpfr_exp_t exp;
char* buf = mpfr_get_str(0, &exp, 10, 0, num, QORE_MPFR_RND);
if (!buf) {
numError(str);
return;
}
ON_BLOCK_EXIT(mpfr_free_str, buf);
//printd(5, "qore_number_private::getAsString(round: %d) this: %p buf: '%s'\n", round, this, buf);
// if it's a regular number, then format accordingly
if (number()) {
int sgn = sign();
qore_size_t len = str.size() + (sgn < 0 ? 1 : 0);
//printd(5, "qore_number_private::getAsString() this: %p '%s' exp "QLLD" len: "QLLD"\n", this, buf, exp, len);
qore_size_t dp = 0;
str.concat(buf);
// trim the trailing zeros off the end
str.trim_trailing('0');
if (exp <= 0) {
exp = -exp;
str.insert("0.", len);
dp = len + 1;
//printd(5, "qore_number_private::getAsString() this: %p str: '%s' exp: "QLLD" dp: "QLLD" len: "QLLD"\n", this, str.getBuffer(), exp, dp, len);
if (exp)
str.insertch('0', len + 2, exp);
}
else {
// get remaining length of string (how many characters were added)
qore_size_t rlen = str.size() - len;
//printd(5, "qore_number_private::getAsString() this: %p str: '%s' exp: "QLLD" rlen: "QLLD"\n", this, str.getBuffer(), exp, rlen);
// assert that we have added at least 1 character
assert(rlen > 0);
if ((qore_size_t)exp > rlen)
str.insertch('0', str.size(), exp - rlen);
else if ((qore_size_t)exp < rlen) {
str.insertch('.', len + exp, 1);
dp = len + exp;
}
}
// try to do some rounding (noise reduction with binary->decimal conversions)
if (dp && round)
applyRoundingHeuristic(str, dp, str.size());
}
else
str.concat(buf);
//printd(5, "qore_number_private::getAsString() this: %p returning '%s'\n", this, str.getBuffer());
}
/* bugs found by Alain Delplanque */
static void
check_large (void)
{
mpfr_t x;
char *s, s1[7];
const char xm[] = { '1', '1', '9', '1', '3', '2', '9', '3', '7', '3',
'5', '8', '4', '4', '5', '4', '9', '0', '2', '9',
'6', '3', '4', '4', '6', '9', '9', '1', '9', '5',
'5', '7', '2', '0', '1', '7', '5', '2', '8', '6',
'1', '2', '5', '2', '5', '2', '7', '4', '0', '2',
'7', '9', '1', '1', '7', '4', '5', '6', '7', '5',
'9', '3', '1', '4', '2', '5', '5', '6', '6', '6',
'1', '6', '4', '3', '8', '1', '2', '8', '7', '6',
'2', '9', '2', '0', '8', '8', '9', '4', '3', '9',
'6', '2', '8', '4', '1', '1', '8', '1', '0', '6',
'2', '3', '7', '6', '3', '8', '1', '5', '1', '7',
'3', '4', '6', '1', '2', '4', '0', '1', '3', '0',
'8', '4', '1', '3', '9', '3', '2', '0', '1', '6',
'3', '6', '7', '1', '5', '1', '7', '5', '0', '1',
'9', '8', '4', '0', '8', '2', '7', '9', '1', '3',
'2', '2', '8', '3', '4', '1', '6', '2', '3', '9',
'6', '2', '0', '7', '3', '5', '5', '5', '3', '4',
'2', '1', '7', '0', '9', '7', '6', '2', '1', '0',
'3', '3', '5', '4', '7', '6', '0', '9', '7', '6',
'9', '3', '5', '1', '7', '8', '6', '8', '8', '2',
'8', '1', '4', '3', '7', '4', '3', '3', '2', '4',
'1', '5', '4', '7', '8', '1', '1', '4', '2', '1',
'2', '4', '2', '7', '6', '5', '9', '5', '4', '5',
'2', '6', '7', '3', '0', '3', '4', '0', '6', '9',
'1', '8', '9', '9', '9', '8', '0', '5', '7', '0',
'9', '3', '8', '7', '6', '2', '4', '6', '1', '6',
'7', '2', '0', '3', '5', '9', '3', '5', '8', '8',
'9', '7', '7', '9', '2', '7', '0', '8', '1', '6',
'8', '7', '4', '8', '5', '3', '0', '8', '4', '3',
'5', '6', '5', '1', '6', '6', '0', '9', '7', '9',
'8', '9', '2', '7', '2', '6', '8', '5', '9', '4',
'5', '8', '1', '3', '7', '2', '9', '3', '8', '3',
'7', '9', '1', '7', '9', '9', '7', '7', '2', '8',
'4', '6', '5', '5', '7', '3', '3', '8', '3', '6',
'6', '9', '7', '1', '4', '3', '3', '7', '1', '4',
'9', '4', '1', '2', '4', '9', '5', '1', '4', '7',
'2', '6', '4', '4', '8', '0', '6', '2', '6', '0',
'6', '9', '8', '1', '1', '7', '9', '9', '3', '9',
'3', '8', '4', '7', '3', '1', '9', '0', '2', '3',
'5', '3', '5', '4', '2', '1', '1', '7', '6', '7',
'4', '3', '2', '2', '0', '6', '5', '9', '9', '3',
'2', '6', '7', '1', '2', '0', '0', '3', '7', '3',
'8', '7', '4', '3', '3', '3', '3', '3', '2', '3',
'8', '2', '8', '6', '3', '1', '5', '5', '2', '2',
'5', '9', '3', '3', '7', '0', '6', '2', '8', '1',
'0', '3', '6', '7', '6', '9', '6', '5', '9', '0',
'6', '6', '6', '3', '6', '9', '9', '3', '8', '7',
'6', '5', '4', '5', '3', '5', '9', '4', '0', '0',
'7', '5', '8', '5', '4', '1', '4', '3', '1', '5',
'7', '6', '6', '3', '4', '4', '5', '0', '8', '7',
'5', '7', '5', '0', '1', '0', '1', '8', '4', '7',
'3', '1', '9', '9', '2', '7', '1', '1', '1', '2',
'3', '9', '9', '6', '5', '9', '2', '3', '2', '8',
'1', '5', '5', '1', '2', '6', '4', '9', '6', '6',
'4', '5', '1', '1', '6', '0', '0', '3', '2', '8',
'4', '8', '7', '1', '4', '9', '6', '8', '1', '6',
'5', '9', '8', '3', '4', '2', '9', '7', '0', '1',
'9', '2', '6', '6', '9', '1', '3', '5', '9', '3',
'2', '9', '6', '2', '3', '0', '6', '0', '1', '1',
'6', '5', '1', '7', '9', '0', '7', '5', '8', '6',
'8', '4', '2', '1', '0', '3', '8', '6', '6', '4',
'4', '9', '9', '7', '5', '8', '1', '7', '5', '7',
'9', '6', '6', '8', '8', '5', '8', '6', '7', '4',
'0', '7', '2', '0', '2', '9', '9', '4', '4', '1',
'9', '5', '8', '6', '5', '0', '6', '7', '4', '2',
'7', '3', '2', '3', '2', '7', '0', '2', '1', '3',
'0', '5', '9', '0', '3', '9', '1', '4', '5', '3',
'7', '2', '7', '0', '8', '5', '5', '4', '6', '1',
'1', '0', '0', '9', '2', '0', '4', '1', '6', '6',
'4', '6', '9', '1', '3', '2', '8', '5', '0', '3',
'3', '8', '9', '8', '7', '8', '5', '9', '5', '5',
'9', '1', '9', '3', '6', '5', '4', '1', '7', '4',
'0', '2', '4', '7', '2', '9', '7', '1', '2', '4',
'5', '8', '1', '4', '4', '6', '1', '8', '5', '8',
'7', '6', '9', '7', '2', '1', '2', '0', '8', '9',
'5', '9', '5', '5', '3', '8', '1', '2', '5', '4',
'3', '0', '7', '6', '5', '1', '7', '8', '2', '0',
'0', '7', '6', '7', '4', '8', '1', '0', '6', '3',
'2', '3', '0', '5', '2', '5', '0', '1', '1', '4',
'3', '8', '4', '5', '2', '3', '9', '5', '0', '9',
'8', '2', '6', '4', '7', '4', '8', '0', '1', '1',
'7', '1', '5', '4', '9', '0', '9', '2', '2', '3',
'8', '1', '6', '9', '0', '4', '6', '4', '5', '4',
'6', '3', '8', '7', '3', '6', '1', '7', '2', '3',
'4', '5', '5', '2', '0', '2', '5', '8', '1', '4',
'9', '3', '0', '7', '4', '1', '6', '8', '7', '8',
'2', '6', '2', '5', '1', '0', '7', '4', '7', '3',
'6', '6', '4', '5', '6', '6', '6', '6', '8', '5',
'1', '3', '5', '7', '1', '6', '2', '0', '9', '2',
'3', '2', '6', '0', '7', '9', '8', '1', '6', '2',
'0', '3', '8', '8', '0', '2', '8', '7', '7', '5',
'9', '3', '1', '0', '6', '7', '5', '7', '3', '1',
'2', '7', '7', '2', '0', '0', '4', '1', '2', '8',
'2', '0', '8', '4', '0', '5', '0', '5', '0', '1',
'9', '3', '3', '6', '3', '6', '9', '6', '2', '8',
'2', '9', '7', '5', '3', '8', '8', '9', '1', '1',
'4', '5', '7', '7', '5', '6', '0', '2', '7', '9',
'7', '2', '1', '7', '4', '3', '0', '3', '6', '7',
'3', '7', '2', '2', '7', '5', '6', '2', '3', '1',
'2', '1', '3', '1', '4', '2', '6', '9', '2', '3',
'\0' };
mpfr_exp_t e;
mpfr_init2 (x, 3322);
mpfr_set_str (x, xm, 10, MPFR_RNDN);
mpfr_div_2exp (x, x, 4343, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (s[999] != '1') /* s must be 5.04383...689071e-309 */
{
printf ("Error in check_large: expected '689071', got '%s'\n",
s + 994);
exit (1);
}
mpfr_free_str (s);
mpfr_mul_2exp (x, x, 4343, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (strcmp (s, "12") || (e != 1000))
{
printf ("Error in check_large: expected 0.12e1000\n");
printf ("got %se%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_nan (x);
mpfr_clear_flags ();
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (strcmp (s, "@NaN@"))
{
printf ("Error for NaN (incorrect string)\n");
exit (1);
}
if (__gmpfr_flags != MPFR_FLAGS_NAN)
{
printf ("Error for NaN (incorrect flags)\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 1000, x, MPFR_RNDN);
mpfr_set_inf (x, 1);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (strcmp (s, "@Inf@"))
{
printf ("Error for Inf\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 1000, x, MPFR_RNDN);
mpfr_set_inf (x, -1);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (strcmp (s, "-@Inf@"))
{
printf ("Error for -Inf\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 1000, x, MPFR_RNDN);
mpfr_set_ui (x, 0, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (e != 0 || strcmp (s, "00"))
{
printf ("Error for 0.0\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 2, x, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN); /* -0.0 */
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (e != 0 || strcmp (s, "-00"))
{
printf ("Error for -0.0\ngot %se%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 2, x, MPFR_RNDN);
mpfr_clear (x);
}
static void
check_small (void)
{
mpfr_t x;
char *s;
mpfr_exp_t e;
mpfr_prec_t p;
mpfr_init (x);
mpfr_set_prec (x, 20);
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_nexttozero (x);
s = mpfr_get_str (NULL, &e, 4, 2, x, MPFR_RNDU);
if (strcmp (s, "20") || (e != 1))
{
printf ("Error in mpfr_get_str: 2- rounded up with 2 digits"
" in base 4\n");
exit (1);
}
mpfr_free_str (s);
/* check n_digits=0 */
mpfr_set_prec (x, 5);
mpfr_set_ui (x, 17, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 3, 0, x, MPFR_RNDN);
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 36, 0, x, MPFR_RNDN);
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 62, 0, x, MPFR_RNDN);
mpfr_free_str (s);
mpfr_set_prec (x, 64);
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_div_2exp (x, x, 63, MPFR_RNDN); /* x = -2^(-63) */
mpfr_add_ui (x, x, 1, MPFR_RNDN); /* x = 1 - 2^(-63) */
mpfr_mul_2exp (x, x, 32, MPFR_RNDN); /* x = 2^32 - 2^(-31) */
s = mpfr_get_str (NULL, &e, 3, 21, x, MPFR_RNDU);
if (strcmp (s, "102002022201221111211") || (e != 21))
{
printf ("Error in mpfr_get_str: 2^32-2^(-31) rounded up with"
" 21 digits in base 3\n");
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 3, 20, x, MPFR_RNDU);
if (strcmp (s, "10200202220122111122") || (e != 21))
{
printf ("Error in mpfr_get_str: 2^32-2^(-31) rounded up with"
" 20 digits in base 3\n");
exit (1);
}
mpfr_free_str (s);
/* check corner case ret!=0, j0!=0 in mpfr_get_str_aux */
mpfr_set_prec (x, 100);
mpfr_set_str_binary (x, "0.1001011111010001101110010101010101111001010111111101101101100110100011110110000101110110001011110000E-9");
s = mpfr_get_str (NULL, &e, 3, 2, x, MPFR_RNDU);
if (strcmp (s, "22") || (e != -6))
{
printf ("Error in mpfr_get_str: 100-bit number rounded up with"
" 2 digits in base 3\n");
exit (1);
}
mpfr_free_str (s);
/* check corner case exact=0 in mpfr_get_str_aux */
mpfr_set_prec (x, 100);
mpfr_set_str_binary (x, "0.1001001111101101111000101000110111111010101100000110010001111111011001101011101100001100110000000000E8");
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDZ);
if (strcmp (s, "14") || (e != 3))
{
printf ("Error in mpfr_get_str: 100-bit number rounded to zero with"
" 2 digits in base 10\n");
exit (1);
}
mpfr_free_str (s);
for (p=4; p<=200; p++)
{
mpfr_set_prec (x, p);
mpfr_set_str (x, "6.5", 10, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 6, 2, x, MPFR_RNDN);
if (strcmp (s, "10") || (e != 2))
{
printf ("Error in mpfr_get_str: 6.5 rounded to nearest with"
" 2 digits in base 6\n");
exit (1);
}
mpfr_free_str (s);
mpfr_nexttoinf (x);
s = mpfr_get_str (NULL, &e, 6, 2, x, MPFR_RNDN);
if (strcmp (s, "11") || (e != 2))
{
printf ("Error in mpfr_get_str: 6.5+ rounded to nearest with"
" 2 digits in base 6\ngot %se%d instead of 11e2\n",
s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str (x, "6.5", 10, MPFR_RNDN);
mpfr_nexttozero (x);
s = mpfr_get_str (NULL, &e, 6, 2, x, MPFR_RNDN);
if (strcmp (s, "10") || (e != 2))
{
printf ("Error in mpfr_get_str: 6.5- rounded to nearest with"
" 2 digits in base 6\n");
exit (1);
}
mpfr_free_str (s);
}
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 7, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 2, 2, x, MPFR_RNDU);
if (strcmp (s, "10") || (e != 4))
{
printf ("Error in mpfr_get_str: 7 rounded up with 2 bits should"
" give 0.10e3 instead of 0.%s*2^%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* problem found by Fabrice Rouillier */
mpfr_set_prec (x, 63);
mpfr_set_str (x, "5e14", 10, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 18, x, MPFR_RNDU);
mpfr_free_str (s);
/* bug found by Johan Vervloet */
mpfr_set_prec (x, 6);
mpfr_set_str (x, "688.0", 10, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 2, 4, x, MPFR_RNDU);
if (strcmp (s, "1011") || (e != 10))
{
printf ("Error in mpfr_get_str: 688 printed up to 4 bits should"
" give 1.011e9\ninstead of ");
mpfr_out_str (stdout, 2, 4, x, MPFR_RNDU);
puts ("");
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 38);
mpfr_set_str_binary (x, "1.0001110111110100011010100010010100110e-6");
s = mpfr_get_str (NULL, &e, 8, 10, x, MPFR_RNDU);
if (strcmp (s, "1073721522") || (e != -1))
{
printf ("Error in mpfr_get_str (3): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "0.11010111011101100010000100010101110001000000010111001E454");
s = mpfr_get_str (NULL, &e, 19, 12, x, MPFR_RNDU);
if (strcmp (s, "b1cgfa4gha0h") || (e != 107))
{
printf ("Error in mpfr_get_str (4): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 145);
mpfr_set_str_binary (x, "-0.1000110011000001011000010101101010110110101100101110100011111100011110011001001001010000100001000011000011000000010111011001000111101001110100110e6");
s = mpfr_get_str (NULL, &e, 4, 53, x, MPFR_RNDU);
if (strcmp (s, "-20303001120111222312230232203330132121021100201003003") || (e != 3))
{
printf ("Error in mpfr_get_str (5): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 45);
mpfr_set_str_binary (x, "-0.00100111010110010001011001110111010001010010010");
s = mpfr_get_str (NULL, &e, 32, 9, x, MPFR_RNDN);
if (strcmp (s, "-4tchctq54") || (e != 0))
{
printf ("Error in mpfr_get_str (6): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* worst case found by Vincent Lefe`vre */
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "10011110111100000000001011011110101100010000011011111E164");
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDN);
if (strcmp (s, "13076622631878654") || (e != 66))
{
printf ("Error in mpfr_get_str (7): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10000001001001001100011101010011011011111000011000100E93");
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDU);
if (strcmp (s, "46") || e != 44)
{
printf ("Error in mpfr_get_str (8): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10010001111100000111001111010101001010000010111010101E55");
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (strcmp (s, "19") || e != 33)
{
printf ("Error in mpfr_get_str (9): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11011001010010111110010101101100111110111000010110110E44");
s = mpfr_get_str (NULL, &e, 10, 3, x, MPFR_RNDN);
if (strcmp (s, "135") || e != 30)
{
printf ("Error in mpfr_get_str (10): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11101111101000001011100001111000011111101111011001100E72");
s = mpfr_get_str (NULL, &e, 10, 4, x, MPFR_RNDN);
if (strcmp (s, "3981") || e != 38)
{
printf ("Error in mpfr_get_str (11): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10011001001100100010111100001101110101001001111110000E46");
s = mpfr_get_str (NULL, &e, 10, 5, x, MPFR_RNDN);
if (strcmp (s, "37930") || e != 30)
{
printf ("Error in mpfr_get_str (12): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10001100110111001011011110011011011101100011010001011E-72");
s = mpfr_get_str (NULL, &e, 10, 6, x, MPFR_RNDN);
if (strcmp (s, "104950") || e != -5)
{
printf ("Error in mpfr_get_str (13): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10100100001011001000011001101101000110100110000010111E89");
s = mpfr_get_str (NULL, &e, 10, 7, x, MPFR_RNDN);
if (strcmp (s, "3575392") || e != 43)
{
printf ("Error in mpfr_get_str (14): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11000011011110110010100110001010000001010011001011001E-73");
s = mpfr_get_str (NULL, &e, 10, 8, x, MPFR_RNDN);
if (strcmp (s, "72822386") || e != -6)
{
printf ("Error in mpfr_get_str (15): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10101010001101000111001100001000100011100010010001010E78");
s = mpfr_get_str (NULL, &e, 10, 9, x, MPFR_RNDN);
if (strcmp (s, "180992873") || e != 40)
{
printf ("Error in mpfr_get_str (16): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10110111001000100000001101111001100101101110011011101E91");
s = mpfr_get_str (NULL, &e, 10, 10, x, MPFR_RNDN);
if (strcmp (s, "1595312255") || e != 44)
{
printf ("Error in mpfr_get_str (17): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10011101010111101111000100111011101011110100110110101E93");
s = mpfr_get_str (NULL, &e, 10, 11, x, MPFR_RNDN);
if (strcmp (s, "54835744350") || e != 44)
{
printf ("Error in mpfr_get_str (18): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10011101010111101111000100111011101011110100110110101E92");
s = mpfr_get_str (NULL, &e, 10, 12, x, MPFR_RNDN);
if (strcmp (s, "274178721752") || e != 44)
{
printf ("Error in mpfr_get_str (19): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10011101010111101111000100111011101011110100110110101E91");
s = mpfr_get_str (NULL, &e, 10, 13, x, MPFR_RNDN);
if (strcmp (s, "1370893608762") || e != 44)
{
printf ("Error in mpfr_get_str (20): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10010011010110011100010010100101100011101000011111111E92");
s = mpfr_get_str (NULL, &e, 10, 14, x, MPFR_RNDN);
if (strcmp (s, "25672105101864") || e != 44)
{
printf ("Error in mpfr_get_str (21): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "100110111110110001000101110100100101101000011111001E87");
s = mpfr_get_str (NULL, &e, 10, 15, x, MPFR_RNDN);
if (strcmp (s, "212231308858721") || e != 42)
{
printf ("Error in mpfr_get_str (22): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10111010110000111000101100101111001011011100101001111E-128");
s = mpfr_get_str (NULL, &e, 10, 15, x, MPFR_RNDN);
if (strcmp (s, "193109287087290") || e != -22)
{
printf ("Error in mpfr_get_str (22b): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10001101101011010001111110000111010111010000110101010E80");
s = mpfr_get_str (NULL, &e, 10, 16, x, MPFR_RNDN);
if (strcmp (s, "6026241735727920") || e != 40)
{
printf ("Error in mpfr_get_str (23): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "100010001011101001110101000110011001001000110001001E-81");
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDN);
if (strcmp (s, "49741483709103481") || e != -9)
{
printf ("Error in mpfr_get_str (24): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11000100001001001110111010011001111001001010110101111E-101");
s = mpfr_get_str (NULL, &e, 10, 7, x, MPFR_RNDN);
if (strcmp (s, "2722049") || e != -14)
{
printf ("Error in mpfr_get_str (25): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11111001010011100101000001111111110001001001110110001E-135");
s = mpfr_get_str (NULL, &e, 10, 8, x, MPFR_RNDN);
if (strcmp (s, "20138772") || e != -24)
{
printf ("Error in mpfr_get_str (26): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11111001010011100101000001111111110001001001110110001E-136");
s = mpfr_get_str (NULL, &e, 10, 9, x, MPFR_RNDN);
if (strcmp (s, "100693858") || e != -24)
{
printf ("Error in mpfr_get_str (27): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10001000001110010110001011111011111011011010000110001E-110");
s = mpfr_get_str (NULL, &e, 10, 14, x, MPFR_RNDN);
if (strcmp (s, "36923634350619") || e != -17)
{
printf ("Error in mpfr_get_str (28): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11001100010111000111100010000110011101110001000101111E-87");
s = mpfr_get_str (NULL, &e, 10, 16, x, MPFR_RNDN);
if (strcmp (s, "4646636036100804") || e != -10)
{
printf ("Error in mpfr_get_str (29): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "10011111001111110100001001010111111011010101111111000E-99");
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDN);
if (strcmp (s, "88399901882446712") || e != -14)
{
printf ("Error in mpfr_get_str (30): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 8116315218207718*2^(-293) ~ 0.5100000000000000000015*10^(-72) */
mpfr_set_str_binary (x, "11100110101011011111011100101011101110110001111100110E-293");
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDU);
if (strcmp (s, "52") || e != -72)
{
printf ("Error in mpfr_get_str (31u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDD);
if (strcmp (s, "51") || e != -72)
{
printf ("Error in mpfr_get_str (31d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 6712731423444934*2^536 ~ .151000000000000000000067*10^178 */
mpfr_set_str_binary (x, "10111110110010011000110010011111101111000111111000110E536");
s = mpfr_get_str (NULL, &e, 10, 3, x, MPFR_RNDU);
if (strcmp (s, "152") || e != 178)
{
printf ("Error in mpfr_get_str (32u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 3, x, MPFR_RNDD);
if (strcmp (s, "151") || e != 178)
{
printf ("Error in mpfr_get_str (32d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 3356365711722467*2^540 ~ .120800000000000000000054*10^179 */
mpfr_set_str_binary (x, "1011111011001001100011001001111110111100011111100011E540");
s = mpfr_get_str (NULL, &e, 10, 4, x, MPFR_RNDU);
if (strcmp (s, "1209") || e != 179)
{
printf ("Error in mpfr_get_str (33u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 4, x, MPFR_RNDD);
if (strcmp (s, "1208") || e != 179)
{
printf ("Error in mpfr_get_str (33d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 6475049196144587*2^100 ~ .8208099999999999999999988*10^46 */
mpfr_set_str_binary (x, "10111000000010000010111011111001111010100011111001011E100");
s = mpfr_get_str (NULL, &e, 10, 5, x, MPFR_RNDU);
if (strcmp (s, "82081") || e != 46)
{
printf ("Error in mpfr_get_str (34u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 5, x, MPFR_RNDD);
if (strcmp (s, "82080") || e != 46)
{
printf ("Error in mpfr_get_str (34d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 6722280709661868*2^364 ~ .25260100000000000000000012*10^126 */
mpfr_set_str_binary (x, "10111111000011110000011110001110001111010010010101100E364");
s = mpfr_get_str (NULL, &e, 10, 6, x, MPFR_RNDU);
if (strcmp (s, "252602") || e != 126)
{
printf ("Error in mpfr_get_str (35u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 6, x, MPFR_RNDD);
if (strcmp (s, "252601") || e != 126)
{
printf ("Error in mpfr_get_str (35d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 5381065484265332*2^(-455) ~ .578389299999999999999999982*10^(-121) */
mpfr_set_str_binary (x, "10011000111100000110011110000101100111110011101110100E-455");
s = mpfr_get_str (NULL, &e, 10, 7, x, MPFR_RNDU);
if (strcmp (s, "5783893") || e != -121)
{
printf ("Error in mpfr_get_str (36u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 7, x, MPFR_RNDD);
if (strcmp (s, "5783892") || e != -121)
{
printf ("Error in mpfr_get_str (36d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 8369123604277281*2^(-852) ~ .27869147000000000000000000056*10^(-240) */
mpfr_set_str_binary (x, "11101101110111010110001101111100000111010100000100001E-852");
s = mpfr_get_str (NULL, &e, 10, 8, x, MPFR_RNDU);
if (strcmp (s, "27869148") || e != -240)
{
printf ("Error in mpfr_get_str (37u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 8, x, MPFR_RNDD);
if (strcmp (s, "27869147") || e != -240)
{
printf ("Error in mpfr_get_str (37d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 7976538478610756*2^377 ~ .245540326999999999999999999982*10^130 */
mpfr_set_str_binary (x, "11100010101101001111010010110100011100000100101000100E377");
s = mpfr_get_str (NULL, &e, 10, 9, x, MPFR_RNDU);
if (strcmp (s, "245540327") || e != 130)
{
printf ("Error in mpfr_get_str (38u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 9, x, MPFR_RNDD);
if (strcmp (s, "245540326") || e != 130)
{
printf ("Error in mpfr_get_str (38d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 8942832835564782*2^(-382) ~ .9078555839000000000000000000038*10^(-99) */
mpfr_set_str_binary (x, "11111110001010111010110000110011100110001010011101110E-382");
s = mpfr_get_str (NULL, &e, 10, 10, x, MPFR_RNDU);
if (strcmp (s, "9078555840") || e != -99)
{
printf ("Error in mpfr_get_str (39u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 10, x, MPFR_RNDD);
if (strcmp (s, "9078555839") || e != -99)
{
printf ("Error in mpfr_get_str (39d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 4471416417782391*2^(-380) ~ .18157111678000000000000000000077*10^(-98) */
mpfr_set_str_binary (x, "1111111000101011101011000011001110011000101001110111E-380");
s = mpfr_get_str (NULL, &e, 10, 11, x, MPFR_RNDU);
if (strcmp (s, "18157111679") || e != -98)
{
printf ("Error in mpfr_get_str (40u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 11, x, MPFR_RNDD);
if (strcmp (s, "18157111678") || e != -98)
{
printf ("Error in mpfr_get_str (40d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 7225450889282194*2^711 ~ .778380362292999999999999999999971*10^230 */
mpfr_set_str_binary (x, "11001101010111000001001100001100110010000001010010010E711");
s = mpfr_get_str (NULL, &e, 10, 12, x, MPFR_RNDU);
if (strcmp (s, "778380362293") || e != 230)
{
printf ("Error in mpfr_get_str (41u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 12, x, MPFR_RNDD);
if (strcmp (s, "778380362292") || e != 230)
{
printf ("Error in mpfr_get_str (41d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 3612725444641097*2^713 ~ .1556760724585999999999999999999942*10^231 */
mpfr_set_str_binary (x, "1100110101011100000100110000110011001000000101001001E713");
s = mpfr_get_str (NULL, &e, 10, 13, x, MPFR_RNDU);
if (strcmp (s, "1556760724586") || e != 231)
{
printf ("Error in mpfr_get_str (42u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 13, x, MPFR_RNDD);
if (strcmp (s, "1556760724585") || e != 231)
{
printf ("Error in mpfr_get_str (42d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 6965949469487146*2^(-248) ~ .15400733123779000000000000000000016*10^(-58) */
mpfr_set_str_binary (x, "11000101111110111111001111111101001101111000000101010E-248");
s = mpfr_get_str (NULL, &e, 10, 14, x, MPFR_RNDU);
if (strcmp (s, "15400733123780") || e != -58)
{
printf ("Error in mpfr_get_str (43u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 14, x, MPFR_RNDD);
if (strcmp (s, "15400733123779") || e != -58)
{
printf ("Error in mpfr_get_str (43d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 3482974734743573*2^(-244) ~ .12320586499023200000000000000000013*10^(-57) */
mpfr_set_str_binary (x, "1100010111111011111100111111110100110111100000010101E-244");
s = mpfr_get_str (NULL, &e, 10, 15, x, MPFR_RNDU);
if (strcmp (s, "123205864990233") || e != -57)
{
printf ("Error in mpfr_get_str (44u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 15, x, MPFR_RNDD);
if (strcmp (s, "123205864990232") || e != -57)
{
printf ("Error in mpfr_get_str (44d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 7542952370752766*2^(-919) ~ .170206189963739699999999999999999974*10^(-260) */
mpfr_set_str_binary (x, "11010110011000100011001110100100111011100110011111110E-919");
s = mpfr_get_str (NULL, &e, 10, 16, x, MPFR_RNDU);
if (strcmp (s, "1702061899637397") || e != -260)
{
printf ("Error in mpfr_get_str (45u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 16, x, MPFR_RNDD);
if (strcmp (s, "1702061899637396") || e != -260)
{
printf ("Error in mpfr_get_str (45d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
/* 5592117679628511*2^165 ~ .26153245263757307000000000000000000074*10^66 */
mpfr_set_str_binary (x, "10011110111100000000001011011110101100010000011011111E165");
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDU);
if (strcmp (s, "26153245263757308") || e != 66)
{
printf ("Error in mpfr_get_str (46u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDD);
if (strcmp (s, "26153245263757307") || e != 66)
{
printf ("Error in mpfr_get_str (46d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11010010110111100001011010000110010000100001011011101E1223");
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDN);
if (strcmp (s, "10716284017294180") || e != 385)
{
printf ("Error in mpfr_get_str (47n): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 18, x, MPFR_RNDU);
if (strcmp (s, "107162840172941805") || e != 385)
{
printf ("Error in mpfr_get_str (47u): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 18, x, MPFR_RNDD);
if (strcmp (s, "107162840172941804") || e != 385)
{
printf ("Error in mpfr_get_str (47d): s=%s e=%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "11111101111011000001010100001101101000010010001111E122620");
s = mpfr_get_str (NULL, &e, 10, 17, x, MPFR_RNDN);
if (strcmp (s, "22183435284042374") || e != 36928)
{
printf ("Error in mpfr_get_str (48n): s=%s e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 18, x, MPFR_RNDU);
if (strcmp (s, "221834352840423736") || e != 36928)
{
printf ("Error in mpfr_get_str (48u): s=%s e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 18, x, MPFR_RNDD);
if (strcmp (s, "221834352840423735") || e != 36928)
{
printf ("Error in mpfr_get_str (48d): s=%s e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 45);
mpfr_set_str_binary (x, "1E45");
s = mpfr_get_str (NULL, &e, 32, 9, x, MPFR_RNDN);
mpfr_free_str (s);
mpfr_set_prec (x, 7);
mpfr_set_str_binary (x, "0.1010101E10");
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDU);
mpfr_free_str (s);
/* checks rounding of negative numbers */
mpfr_set_prec (x, 7);
mpfr_set_str (x, "-11.5", 10, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDD);
if (strcmp (s, "-12"))
{
printf ("Error in mpfr_get_str for x=-11.5 and rnd=MPFR_RNDD\n"
"got %s instead of -12\n", s);
exit (1);
}
mpfr_free_str (s);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDU);
if (strcmp (s, "-11"))
{
printf ("Error in mpfr_get_str for x=-11.5 and rnd=MPFR_RNDU\n");
exit (1);
}
mpfr_free_str (s);
/* bug found by Jean-Pierre Merlet, produced error in mpfr_get_str */
mpfr_set_prec (x, 128);
mpfr_set_str_binary (x, "0.10111001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011010E3");
s = mpfr_get_str (NULL, &e, 10, 0, x, MPFR_RNDU);
mpfr_free_str (s);
mpfr_set_prec (x, 381);
mpfr_set_str_binary (x, "0.111111111111111111111111111111111111111111111111111111111111111111101110110000100110011101101101001010111000101111000100100011110101010110101110100000010100001000110100000100011111001000010010000010001010111001011110000001110010111101100001111000101101100000010110000101100100000101010110010110001010100111001111100011100101100000100100111001100010010011110011011010110000001000010");
s = mpfr_get_str (NULL, &e, 10, 0, x, MPFR_RNDD);
if (e != 0)
{
printf ("Error in mpfr_get_str for x=0.999999..., exponent is %d"
" instead of 0\n", (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 5);
mpfr_set_str_binary (x, "1101.1"); /* 13.5, or (16)_7 + 1/2 */
s = mpfr_get_str (NULL, &e, 7, 2, x, MPFR_RNDN);
/* we are in the tie case: both surrounding numbers are (16)_7 and
(20)_7: since (16)_7 = 13 is odd and (20)_7 = 14 is even,
we should have s = "20" and e = 2 */
if (e != 2 || strcmp (s, "20"))
{
printf ("Error in mpfr_get_str for x=13.5, base 7\n");
printf ("Expected s=20, e=2, got s=%s, e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
/* try the same example, with input just below or above 13.5 */
mpfr_set_prec (x, 1000);
mpfr_set_str_binary (x, "1101.1");
mpfr_nextabove (x);
s = mpfr_get_str (NULL, &e, 7, 2, x, MPFR_RNDN);
if (e != 2 || strcmp (s, "20"))
{
printf ("Error in mpfr_get_str for x=13.5+tiny, base 7\n");
printf ("Expected s=20, e=2, got s=%s, e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "1101.1");
mpfr_nextbelow (x);
s = mpfr_get_str (NULL, &e, 7, 2, x, MPFR_RNDN);
if (e != 2 || strcmp (s, "16"))
{
printf ("Error in mpfr_get_str for x=13.5-tiny, base 7\n");
printf ("Expected s=16, e=2, got s=%s, e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_prec (x, 7);
mpfr_set_str_binary (x, "110000.1"); /* 48.5, or (66)_7 + 1/2 */
s = mpfr_get_str (NULL, &e, 7, 2, x, MPFR_RNDN);
/* we are in the tie case: both surrounding numbers are (66)_7 and
(100)_7: since (66)_7 = 48 is even and (100)_7 is odd,
we should hase s = "66" and e = 2 */
if (e != 2 || strcmp (s, "66"))
{
printf ("Error in mpfr_get_str for x=48.5, base 7\n");
printf ("Expected s=66, e=2, got s=%s, e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
/* try the same example, with input just below or above 48.5 */
mpfr_set_prec (x, 1000);
mpfr_set_str_binary (x, "110000.1");
mpfr_nextabove (x);
s = mpfr_get_str (NULL, &e, 7, 2, x, MPFR_RNDN);
if (e != 3 || strcmp (s, "10"))
{
printf ("Error in mpfr_get_str for x=48.5+tiny, base 7\n");
printf ("Expected s=10, e=3, got s=%s, e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_str_binary (x, "110000.1");
mpfr_nextbelow (x);
s = mpfr_get_str (NULL, &e, 7, 2, x, MPFR_RNDN);
if (e != 2 || strcmp (s, "66"))
{
printf ("Error in mpfr_get_str for x=48.5-tiny, base 7\n");
printf ("Expected s=66, e=2, got s=%s, e=%ld\n", s, (long) e);
exit (1);
}
mpfr_free_str (s);
mpfr_clear (x);
}
static void
check_special (int b, mpfr_prec_t p)
{
mpfr_t x;
int i, j;
char s[MAX_DIGITS + 2], s2[MAX_DIGITS + 2], c;
mpfr_exp_t e;
int r;
size_t m;
mpfr_init2 (x, p);
/* check for invalid base */
if (mpfr_get_str (s, &e, 1, 10, x, MPFR_RNDN) != NULL)
{
printf ("Error: mpfr_get_str should not accept base = 1\n");
exit (1);
}
if (mpfr_get_str (s, &e, 63, 10, x, MPFR_RNDN) != NULL)
{
printf ("Error: mpfr_get_str should not accept base = 63\n");
exit (1);
}
s2[0] = '1';
for (i = 1; i < MAX_DIGITS + 2; i++)
s2[i] = '0';
mpfr_set_ui (x, 1, MPFR_RNDN);
for (i = 1; i < MAX_DIGITS && mpfr_mul_ui (x, x, b, MPFR_RNDN) == 0; i++)
{
/* x = b^i (exact) */
for (r = 0; r < MPFR_RND_MAX; r++)
for (m = i < 3 ? 2 : i-1 ; (int) m <= i+1 ; m++)
{
mpfr_get_str (s, &e, b, m, x, (mpfr_rnd_t) r);
/* s should be 1 followed by (m-1) zeros, and e should be i+1 */
if ((e != i+1) || strncmp (s, s2, m) != 0)
{
printf ("Error in mpfr_get_str for %d^%d\n", b, i);
exit (1);
}
}
if (mpfr_sub_ui (x, x, 1, MPFR_RNDN) != 0)
break;
/* now x = b^i-1 (exact) */
for (r = 0; r < MPFR_RND_MAX; r++)
if (i >= 2)
{
mpfr_get_str (s, &e, b, i, x, (mpfr_rnd_t) r);
/* should be i times (b-1) */
c = (b <= 10) ? '0' + b - 1 : 'a' + (b - 11);
for (j=0; (j < i) && (s[j] == c); j++);
if ((j < i) || (e != i))
{
printf ("Error in mpfr_get_str for %d^%d-1\n", b, i);
printf ("got 0.%s*2^%d\n", s, (int) e);
exit (1);
}
}
if (i >= 3)
{
mpfr_get_str (s, &e, b, i - 1, x, MPFR_RNDU);
/* should be b^i */
if ((e != i+1) || strncmp (s, s2, i - 1) != 0)
{
printf ("Error in mpfr_get_str for %d^%d-1\n", b, i);
printf ("got 0.%s*2^%d\n", s, (int) e);
exit (1);
}
}
mpfr_add_ui (x, x, 1, MPFR_RNDN);
}
mpfr_clear (x);
}
tree
gfc_conv_mpfr_to_tree (mpfr_t f, int kind)
{
tree res;
tree type;
mp_exp_t exp;
char *p;
char *q;
int n;
int edigits;
for (n = 0; gfc_real_kinds[n].kind != 0; n++)
{
if (gfc_real_kinds[n].kind == kind)
break;
}
gcc_assert (gfc_real_kinds[n].kind);
n = MAX (abs (gfc_real_kinds[n].min_exponent),
abs (gfc_real_kinds[n].max_exponent));
edigits = 1;
while (n > 0)
{
n = n / 10;
edigits += 3;
}
if (kind == gfc_default_double_kind)
p = mpfr_get_str (NULL, &exp, 10, 17, f, GFC_RND_MODE);
else
p = mpfr_get_str (NULL, &exp, 10, 8, f, GFC_RND_MODE);
/* We also have one minus sign, "e", "." and a null terminator. */
q = (char *) gfc_getmem (strlen (p) + edigits + 4);
if (p[0])
{
if (p[0] == '-')
{
strcpy (&q[2], &p[1]);
q[0] = '-';
q[1] = '.';
}
else
{
strcpy (&q[1], p);
q[0] = '.';
}
strcat (q, "e");
sprintf (&q[strlen (q)], "%d", (int) exp);
}
else
{
strcpy (q, "0");
}
type = gfc_get_real_type (kind);
res = build_real (type, REAL_VALUE_ATOF (q, TYPE_MODE (type)));
gfc_free (q);
gfc_free (p);
return res;
}
int
main (int argc, char *argv[])
{
int b;
mpfr_t x;
mpfr_rnd_t r;
char s[MAX_DIGITS + 2];
mpfr_exp_t e, f;
size_t m;
mpfr_prec_t p;
int i;
tests_start_mpfr ();
check_small ();
check_special (2, 2);
for (i = 0; i < ITER; i++)
{
p = 2 + (randlimb () % (MAX_DIGITS - 1));
b = 2 + (randlimb () % 35);
check_special (b, p);
}
mpfr_init2 (x, MAX_DIGITS);
for (i = 0; i < ITER; i++)
{
m = 2 + (randlimb () % (MAX_DIGITS - 1));
mpfr_urandomb (x, RANDS);
e = (mpfr_exp_t) (randlimb () % 21) - 10;
if (!MPFR_IS_ZERO(x))
mpfr_set_exp (x, (e == -10) ? mpfr_get_emin () :
((e == 10) ? mpfr_get_emax () : e));
b = 2 + (randlimb () % 35);
r = RND_RAND ();
mpfr_get_str (s, &f, b, m, x, r);
}
mpfr_clear (x);
check_large ();
check3 ("4.059650008e-83", MPFR_RNDN, "40597");
check3 ("-6.606499965302424244461355e233", MPFR_RNDN, "-66065");
check3 ("-7.4", MPFR_RNDN, "-74000");
check3 ("0.997", MPFR_RNDN, "99700");
check3 ("-4.53063926135729747564e-308", MPFR_RNDN, "-45306");
check3 ("2.14478198760196000000e+16", MPFR_RNDN, "21448");
check3 ("7.02293374921793516813e-84", MPFR_RNDN, "70229");
check3 ("-6.7274500420134077e-87", MPFR_RNDN, "-67275");
check3 ("-6.7274500420134077e-87", MPFR_RNDZ, "-67274");
check3 ("-6.7274500420134077e-87", MPFR_RNDU, "-67274");
check3 ("-6.7274500420134077e-87", MPFR_RNDD, "-67275");
check3 ("-6.7274500420134077e-87", MPFR_RNDA, "-67275");
check3 ("6.7274500420134077e-87", MPFR_RNDN, "67275");
check3 ("6.7274500420134077e-87", MPFR_RNDZ, "67274");
check3 ("6.7274500420134077e-87", MPFR_RNDU, "67275");
check3 ("6.7274500420134077e-87", MPFR_RNDD, "67274");
check3 ("6.7274500420134077e-87", MPFR_RNDA, "67275");
check_bug_base2k ();
check_reduced_exprange ();
tests_end_mpfr ();
return 0;
}
