static void check_pow_si (void) { mpfr_t x; mpfr_init (x); mpfr_set_nan (x); mpfr_pow_si (x, x, -1, GMP_RNDN); MPFR_ASSERTN(mpfr_nan_p (x)); mpfr_set_inf (x, 1); mpfr_pow_si (x, x, -1, GMP_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x)); mpfr_set_inf (x, -1); mpfr_pow_si (x, x, -1, GMP_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x)); mpfr_set_inf (x, -1); mpfr_pow_si (x, x, -2, GMP_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x)); mpfr_set_ui (x, 0, GMP_RNDN); mpfr_pow_si (x, x, -1, GMP_RNDN); MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0); mpfr_set_ui (x, 0, GMP_RNDN); mpfr_neg (x, x, GMP_RNDN); mpfr_pow_si (x, x, -1, GMP_RNDN); MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0); mpfr_set_ui (x, 0, GMP_RNDN); mpfr_neg (x, x, GMP_RNDN); mpfr_pow_si (x, x, -2, GMP_RNDN); MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0); mpfr_set_si (x, 2, GMP_RNDN); mpfr_pow_si (x, x, LONG_MAX, GMP_RNDN); /* 2^LONG_MAX */ if (LONG_MAX > mpfr_get_emax () - 1) /* LONG_MAX + 1 > emax */ { MPFR_ASSERTN (mpfr_inf_p (x)); } else { MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MAX)); } mpfr_set_si (x, 2, GMP_RNDN); mpfr_pow_si (x, x, LONG_MIN, GMP_RNDN); /* 2^LONG_MIN */ if (LONG_MIN + 1 < mpfr_get_emin ()) { MPFR_ASSERTN (mpfr_zero_p (x)); } else { MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MIN)); } mpfr_set_si (x, 2, GMP_RNDN); mpfr_pow_si (x, x, LONG_MIN + 1, GMP_RNDN); /* 2^(LONG_MIN+1) */ if (mpfr_nan_p (x)) { printf ("Error in pow_si(2, LONG_MIN+1): got NaN\n"); exit (1); } if (LONG_MIN + 2 < mpfr_get_emin ()) { MPFR_ASSERTN (mpfr_zero_p (x)); } else { MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MIN + 1)); } mpfr_set_si_2exp (x, 1, -1, GMP_RNDN); /* 0.5 */ mpfr_pow_si (x, x, LONG_MIN, GMP_RNDN); /* 2^(-LONG_MIN) */ if (LONG_MIN < 1 - mpfr_get_emax ()) /* 1 - LONG_MIN > emax */ { MPFR_ASSERTN (mpfr_inf_p (x)); } else { MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 2, - (LONG_MIN + 1))); } mpfr_clear (x); }

static void special (void) { mpfr_t x, y; unsigned xprec, yprec; mpfr_init (x); mpfr_init (y); mpfr_set_prec (x, 32); mpfr_set_prec (y, 32); mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_div_ui (y, x, 3, MPFR_RNDN); mpfr_set_prec (x, 100); mpfr_set_prec (y, 100); mpfr_urandomb (x, RANDS); mpfr_div_ui (y, x, 123456, MPFR_RNDN); mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_div_ui (y, x, 123456789, MPFR_RNDN); if (mpfr_cmp_ui (y, 0)) { printf ("mpfr_div_ui gives non-zero for 0/ui\n"); exit (1); } /* bug found by Norbert Mueller, 21 Aug 2001 */ mpfr_set_prec (x, 110); mpfr_set_prec (y, 60); mpfr_set_str_binary (x, "0.110101110011111110011111001110011001110111000000111110001000111011000011E-44"); mpfr_div_ui (y, x, 17, MPFR_RNDN); mpfr_set_str_binary (x, "0.11001010100101100011101110000001100001010110101001010011011E-48"); if (mpfr_cmp (x, y)) { printf ("Error in x/17 for x=1/16!\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN); printf ("\n"); exit (1); } /* corner case */ mpfr_set_prec (x, 2 * mp_bits_per_limb); mpfr_set_prec (y, 2); mpfr_set_ui (x, 4, MPFR_RNDN); mpfr_nextabove (x); mpfr_div_ui (y, x, 2, MPFR_RNDN); /* exactly in the middle */ MPFR_ASSERTN(mpfr_cmp_ui (y, 2) == 0); mpfr_set_prec (x, 3 * mp_bits_per_limb); mpfr_set_prec (y, 2); mpfr_set_ui (x, 2, MPFR_RNDN); mpfr_nextabove (x); mpfr_div_ui (y, x, 2, MPFR_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0); mpfr_set_prec (x, 3 * mp_bits_per_limb); mpfr_set_prec (y, 2); mpfr_set_si (x, -4, MPFR_RNDN); mpfr_nextbelow (x); mpfr_div_ui (y, x, 2, MPFR_RNDD); MPFR_ASSERTN(mpfr_cmp_si (y, -3) == 0); for (xprec = 53; xprec <= 128; xprec++) { mpfr_set_prec (x, xprec); mpfr_set_str_binary (x, "0.1100100100001111110011111000000011011100001100110111E2"); for (yprec = 53; yprec <= 128; yprec++) { mpfr_set_prec (y, yprec); mpfr_div_ui (y, x, 1, MPFR_RNDN); if (mpfr_cmp(x,y)) { printf ("division by 1.0 fails for xprec=%u, yprec=%u\n", xprec, yprec); printf ("expected "); mpfr_print_binary (x); puts (""); printf ("got "); mpfr_print_binary (y); puts (""); exit (1); } } } /* Bug reported by Mark Dickinson, 6 Nov 2007 */ mpfr_set_si (x, 0, MPFR_RNDN); mpfr_set_si (y, -1, MPFR_RNDN); mpfr_div_ui (y, x, 4, MPFR_RNDN); MPFR_ASSERTN(MPFR_IS_ZERO(y) && MPFR_IS_POS(y)); mpfr_clear (x); mpfr_clear (y); }

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); }

static void check_parse (void) { mpfr_t x; char *s; int res; mpfr_init (x); /* Invalid data */ mpfr_set_si (x, -1, MPFR_RNDN); res = mpfr_strtofr (x, " invalid", NULL, 10, MPFR_RNDN); if (MPFR_NOTZERO (x) || MPFR_IS_NEG (x)) { printf ("Failed parsing ' invalid' (1)\n X="); mpfr_dump (x); exit (1); } MPFR_ASSERTN (res == 0); mpfr_set_si (x, -1, MPFR_RNDN); res = mpfr_strtofr (x, " invalid", &s, 0, MPFR_RNDN); if (MPFR_NOTZERO (x) || MPFR_IS_NEG (x) || strcmp (s, " invalid")) { printf ("Failed parsing ' invalid' (2)\n S=%s\n X=", s); mpfr_dump (x); exit (1); } MPFR_ASSERTN (res == 0); /* Check if it stops correctly */ mpfr_strtofr (x, "15*x", &s, 10, MPFR_RNDN); if (mpfr_cmp_ui (x, 15) || strcmp (s, "*x")) { printf ("Failed parsing '15*x'\n S=%s\n X=", s); mpfr_dump (x); exit (1); } /* Check for leading spaces */ mpfr_strtofr (x, " 1.5E-10 *x^2", &s, 10, MPFR_RNDN); if (mpfr_cmp_str1 (x, "1.5E-10") || strcmp (s, " *x^2")) { printf ("Failed parsing '1.5E-10*x^2'\n S=%s\n X=", s); mpfr_dump (x); exit (1); } /* Check for leading sign */ mpfr_strtofr (x, " +17.5E-42E ", &s, 10, MPFR_RNDN); if (mpfr_cmp_str1 (x, "17.5E-42") || strcmp (s, "E ")) { printf ("Failed parsing '+17.5E-42E '\n S=%s\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-17.5E+42E\n", &s, 10, MPFR_RNDN); if (mpfr_cmp_str1 (x, "-17.5E42") || strcmp (s, "E\n")) { printf ("Failed parsing '-17.5E+42\\n'\n S=%s\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* P form */ mpfr_strtofr (x, "0x42P17", &s, 16, MPFR_RNDN); if (mpfr_cmp_str (x, "8650752", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '0x42P17' (base = 16)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-0X42p17", &s, 16, MPFR_RNDN); if (mpfr_cmp_str (x, "-8650752", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '-0x42p17' (base = 16)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "42p17", &s, 16, MPFR_RNDN); if (mpfr_cmp_str (x, "8650752", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '42p17' (base = 16)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-42P17", &s, 16, MPFR_RNDN); if (mpfr_cmp_str (x, "-8650752", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '-42P17' (base = 16)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "0b1001P17", &s, 2, MPFR_RNDN); if (mpfr_cmp_str (x, "1179648", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '0b1001P17' (base = 2)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-0B1001p17", &s, 2, MPFR_RNDN); if (mpfr_cmp_str (x, "-1179648", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '-0B1001p17' (base = 2)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "1001p17", &s, 2, MPFR_RNDN); if (mpfr_cmp_str (x, "1179648", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '1001p17' (base = 2)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-1001P17", &s, 2, MPFR_RNDN); if (mpfr_cmp_str (x, "-1179648", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '-1001P17' (base = 2)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check for auto-detection of the base */ mpfr_strtofr (x, "+0x42P17", &s, 0, MPFR_RNDN); if (mpfr_cmp_str (x, "42P17", 16, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '+0x42P17'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-42E17", &s, 0, MPFR_RNDN); if (mpfr_cmp_str (x, "-42E17", 10, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '-42E17'\n S=%s\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "-42P17", &s, 0, MPFR_RNDN); if (mpfr_cmp_str (x, "-42", 10, MPFR_RNDN) || strcmp (s, "P17")) { printf ("Failed parsing '-42P17' (base = 0)\n S='%s'\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, " [email protected]", &s, 0, MPFR_RNDN); if (mpfr_cmp_str (x, "[email protected]", 2, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '[email protected]'\n S=%s\n X=", s); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, " 0b0101.011P42", &s, 0, MPFR_RNDN); if (mpfr_cmp_str (x, "[email protected]", 2, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '[email protected]'\n S=%s\n X=", s); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "[email protected]", &s, 0, MPFR_RNDN); if (mpfr_cmp_str (x, "[email protected]", 16, MPFR_RNDN) || *s != 0) { printf ("Failed parsing '+0x42P17'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check for space inside the mantissa */ mpfr_strtofr (x, "+0x4 [email protected]", &s, 0, MPFR_RNDN); if (mpfr_cmp_ui (x, 4) || strcmp(s," [email protected]")) { printf ("Failed parsing '+0x4 [email protected]'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "+0x42 P17", &s, 0, MPFR_RNDN); if (mpfr_cmp_ui (x, 0x42) || strcmp(s," P17")) { printf ("Failed parsing '+0x42 P17'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Space between mantissa and exponent */ mpfr_strtofr (x, " -0b0101P 17", &s, 0, MPFR_RNDN); if (mpfr_cmp_si (x, -5) || strcmp(s,"P 17")) { printf ("Failed parsing '-0b0101P 17'\n S=%s\n X=", s); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check for Invalid exponent. */ mpfr_strtofr (x, " -0b0101PF17", &s, 0, MPFR_RNDN); if (mpfr_cmp_si (x, -5) || strcmp(s,"PF17")) { printf ("Failed parsing '-0b0101PF17'\n S=%s\n X=", s); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* At least one digit in the mantissa. */ mpfr_strtofr (x, " .E10", &s, 0, MPFR_RNDN); if (strcmp(s," .E10")) { printf ("Failed parsing ' .E10'\n S=%s\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check 2 '.': 2.3.4 */ mpfr_strtofr (x, "-1.2.3E4", &s, 0, MPFR_RNDN); if (mpfr_cmp_str1 (x, "-1.2") || strcmp(s,".3E4")) { printf ("Failed parsing '-1.2.3E4'\n S=%s\n X=", s); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check for 0x and 0b */ mpfr_strtofr (x, " 0xG", &s, 0, MPFR_RNDN); if (mpfr_cmp_ui (x, 0) || strcmp(s,"xG")) { printf ("Failed parsing ' 0xG'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, " 0b2", &s, 0, MPFR_RNDN); if (mpfr_cmp_ui (x, 0) || strcmp(s,"b2")) { printf ("Failed parsing ' 0b2'\n S=%s\n X=", s); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, "[email protected]", &s, 0, MPFR_RNDN); if (mpfr_cmp_si (x, -0x23) || strcmp(s,"Z33")) { printf ("Failed parsing '[email protected]'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_strtofr (x, " 0x", &s, 0, MPFR_RNDN); if (mpfr_cmp_ui (x, 0) || strcmp(s,"x")) { printf ("Failed parsing ' 0x'\n S=%s\n X=", s); mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_clear (x); }

int main (int argc, char *argv[]) { mpfr_t x, y; mpfr_exp_t emin, emax; tests_start_mpfr (); test_set_underflow (); test_set_overflow (); check_default_rnd(); mpfr_init (x); mpfr_init (y); emin = mpfr_get_emin (); emax = mpfr_get_emax (); if (emin >= emax) { printf ("Error: emin >= emax\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1024, MPFR_RNDN); mpfr_set_double_range (); mpfr_check_range (x, 0, MPFR_RNDN); if (!mpfr_inf_p (x) || (mpfr_sgn(x) <= 0)) { printf ("Error: 2^1024 rounded to nearest should give +Inf\n"); exit (1); } set_emax (1025); mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1024, MPFR_RNDN); mpfr_set_double_range (); mpfr_check_range (x, 0, MPFR_RNDD); if (!mpfr_number_p (x)) { printf ("Error: 2^1024 rounded down should give a normal number\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1023, MPFR_RNDN); mpfr_add (x, x, x, MPFR_RNDN); if (!mpfr_inf_p (x) || (mpfr_sgn(x) <= 0)) { printf ("Error: x+x rounded to nearest for x=2^1023 should give +Inf\n"); printf ("emax = %ld\n", mpfr_get_emax ()); printf ("got "); mpfr_print_binary (x); puts (""); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1023, MPFR_RNDN); mpfr_add (x, x, x, MPFR_RNDD); if (!mpfr_number_p (x)) { printf ("Error: x+x rounded down for x=2^1023 should give" " a normal number\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_div_2exp (x, x, 1022, MPFR_RNDN); mpfr_set_str_binary (y, "1.1e-1022"); /* y = 3/2*x */ mpfr_sub (y, y, x, MPFR_RNDZ); if (mpfr_cmp_ui (y, 0)) { printf ("Error: y-x rounded to zero should give 0" " for y=3/2*2^(-1022), x=2^(-1022)\n"); printf ("y="); mpfr_print_binary (y); puts (""); exit (1); } set_emin (-1026); mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_div_2exp (x, x, 1025, MPFR_RNDN); mpfr_set_double_range (); mpfr_check_range (x, 0, MPFR_RNDN); if (!MPFR_IS_ZERO (x) ) { printf ("Error: x rounded to nearest for x=2^-1024 should give Zero\n"); printf ("emin = %ld\n", mpfr_get_emin ()); printf ("got "); mpfr_dump (x); exit (1); } mpfr_clear (x); mpfr_clear (y); set_emin (emin); set_emax (emax); check_emin_emax(); check_flags(); check_set_get_prec (); check_powerof2 (); check_set (); tests_end_mpfr (); return 0; }

static void normal (void) { int inexact; mpfr_t x, y; mpfr_init (x); mpfr_init (y); /* x1 = 2^-3 */ mpfr_set_str (x, "1p-3", 2, MPFR_RNDD); mpfr_li2 (x, x, MPFR_RNDN); if (mpfr_cmp_str (x, "0x1087a7a9e42141p-55", 16, MPFR_RNDN) != 0) { printf ("Error for li2(x1)\n"); exit (1); } /* check MPFR_FAST_COMPUTE_IF_SMALL_INPUT */ mpfr_set_prec (x, 2); mpfr_set_prec (y, 20); mpfr_set_ui_2exp (x, 1, -21, MPFR_RNDN); mpfr_li2 (y, x, MPFR_RNDN); MPFR_ASSERTN(mpfr_cmp (y, x) == 0); mpfr_set_si_2exp (x, -1, -21, MPFR_RNDN); mpfr_li2 (y, x, MPFR_RNDN); MPFR_ASSERTN(mpfr_cmp (y, x) == 0); /* worst case */ /* x2 = 0x7F18EA6537E00E983196CDDC6EFAC57Fp-129 Li2(x2) = 2^-2 + 2^-6 + 2^-120 */ mpfr_set_prec (x, 128); mpfr_set_str (x, "7F18EA6537E00E983196CDDC6EFAC57Fp-129", 16, MPFR_RNDN); /* round to nearest mode and 4 bits of precision, it should be rounded to 2^-2 + 2^-5 and */ mpfr_set_prec (y, 4); inexact = mpfr_li2 (y, x, MPFR_RNDN); if (inexact != 1 || mpfr_cmp_str (y, "0.1001p-1", 2, MPFR_RNDN) != 0) { printf ("Error for li2(x2, RNDN)\n"); exit (1); } /* round toward zero mode and 5 bits of precision, it should be rounded to 2^-2 + 2^-6 */ mpfr_set_prec (y, 5); inexact = mpfr_li2 (y, x, MPFR_RNDZ); if (inexact != -1 || mpfr_cmp_str (y, "0.10001p-1", 2, MPFR_RNDN) != 0) { printf ("Error for li2(x2, RNDZ)\n"); exit (1); } /* round away from zero mode and 5 bits of precision, it should be rounded to 2^-2 + 2^-5 */ inexact = mpfr_li2 (y, x, MPFR_RNDU); if (inexact != 1 || mpfr_cmp_str (y, "0.10010p-1", 2, MPFR_RNDN) != 0) { printf ("Error for li2(x2, RNDU)\n"); exit (1); } mpfr_clear (x); mpfr_clear (y); }

void EigenLib_cplx_mpType_Print(const char * Title, mpCplxMatrixPtr xPtr) { int mRows = xPtr->rows(); int mCols = xPtr->cols(); cplx_mpType x; printf ("\n"); printf (Title); printf ("\n"); #if defined (Use_Mpfi) mpfr_t real_fL; mpfr_init(real_fL); mpfr_t real_fR; mpfr_init(real_fR); mpfr_t imag_fL; mpfr_init(imag_fL); mpfr_t imag_fR; mpfr_init(imag_fR); #endif // defined (Use_Mpfi) for (int i=1; i<=mRows; i++) { for (int j=1; j<=mCols; j++) { EigenLib_cplx_mpType_GetCoeff(&x, i-1, j-1, xPtr); #if defined (Use_Float) __mingw_printf("(%.8E,%.8E) ", real(x), imag(x)); #endif #if defined (Use_Double) __mingw_printf("(%.16E,%.16E) ", real(x), imag(x)); #endif #if defined (Use_LongDouble) __mingw_printf("(%.20LE,%.20LE) ", real(x), imag(x)); #endif #if defined (Use_Mpfr) mpfr_printf("(%.RE,%.RE) ", real(x).mpfr_ptr(), imag(x).mpfr_ptr()); #endif #if defined (Use_Mpfi) mpfi_get_left(real_fL, real(x).mpfi_ptr()); mpfi_get_right(real_fR, real(x).mpfi_ptr()); mpfi_get_left(imag_fL, imag(x).mpfi_ptr()); mpfi_get_right(imag_fR, imag(x).mpfi_ptr()); mpfr_printf("([%.RE,%.RE] [%.RE,%.RE]) ", real_fL, real_fR, imag_fL, imag_fR); #endif #if defined (Use_Mpdec) char *s1 = mpd_to_sci(real(x).mpd_ptr(), 1); char *s2 = mpd_to_sci(imag(x).mpd_ptr(), 1); printf("(%s,%s)", s1, s2); mpd_free(s1); mpd_free(s2); #endif } printf("\n"); } #if defined (Use_Mpfi) mpfr_clear(real_fL); mpfr_clear(real_fR); mpfr_clear(imag_fL); mpfr_clear(imag_fR); #endif // defined (Use_Mpfi) }

int mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd) { int ok_re = 0, ok_im = 0; mpc_t res, c_conj; mpfr_t q; mpfr_prec_t prec; int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0; int underflow_norm, overflow_norm, underflow_prod, overflow_prod; int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0; mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd); int saved_underflow, saved_overflow; int tmpsgn; mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */ mpc_t b_scaled, c_scaled; mpfr_t b_re, b_im, c_re, c_im; /* According to the C standard G.3, there are three types of numbers: */ /* finite (both parts are usual real numbers; contains 0), infinite */ /* (at least one part is a real infinity) and all others; the latter */ /* are numbers containing a nan, but no infinity, and could reasonably */ /* be called nan. */ /* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */ /* all other divisions that are not finite/finite return nan+i*nan. */ /* Division by 0 could be handled by the following case of division by */ /* a real; we handle it separately instead. */ if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */ return mpc_div_zero (a, b, c, rnd); else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite and both Re(c) and Im(c) are ordinary */ return mpc_div_inf_fin (a, b, c); else if (mpc_fin_p (b) && mpc_inf_p (c)) return mpc_div_fin_inf (a, b, c); else if (!mpc_fin_p (b) || !mpc_fin_p (c)) { mpc_set_nan (a); return MPC_INEX (0, 0); } else if (mpfr_zero_p(mpc_imagref(c))) return mpc_div_real (a, b, c, rnd); else if (mpfr_zero_p(mpc_realref(c))) return mpc_div_imag (a, b, c, rnd); prec = MPC_MAX_PREC(a); mpc_init2 (res, 2); mpfr_init (q); /* compute scaling of exponents: none of Re(c) and Im(c) can be zero, but one of Re(b) or Im(b) could be zero */ e = mpfr_get_exp (mpc_realref (c)); emin = emax = e; e = mpfr_get_exp (mpc_imagref (c)); if (e > emax) emax = e; else if (e < emin) emin = e; if (!mpfr_zero_p (mpc_realref (b))) { e = mpfr_get_exp (mpc_realref (b)); if (e > emax) emax = e; else if (e < emin) emin = e; } if (!mpfr_zero_p (mpc_imagref (b))) { e = mpfr_get_exp (mpc_imagref (b)); if (e > emax) emax = e; else if (e < emin) emin = e; } /* all input exponents are in [emin, emax] */ emid = emin / 2 + emax / 2; /* scale the inputs */ b_re[0] = mpc_realref (b)[0]; if (!mpfr_zero_p (mpc_realref (b))) MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid; b_im[0] = mpc_imagref (b)[0]; if (!mpfr_zero_p (mpc_imagref (b))) MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid; c_re[0] = mpc_realref (c)[0]; MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid; c_im[0] = mpc_imagref (c)[0]; MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid; /* create the scaled inputs without allocating new memory */ mpc_realref (b_scaled)[0] = b_re[0]; mpc_imagref (b_scaled)[0] = b_im[0]; mpc_realref (c_scaled)[0] = c_re[0]; mpc_imagref (c_scaled)[0] = c_im[0]; /* create the conjugate of c in c_conj without allocating new memory */ mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0]; mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0]; MPFR_CHANGE_SIGN (mpc_imagref (c_conj)); /* save the underflow or overflow flags from MPFR */ saved_underflow = mpfr_underflow_p (); saved_overflow = mpfr_overflow_p (); do { loops ++; prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2; mpc_set_prec (res, prec); mpfr_set_prec (q, prec); /* first compute norm(c_scaled) */ mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU); underflow_norm = mpfr_underflow_p (); overflow_norm = mpfr_overflow_p (); if (underflow_norm) mpfr_set_ui (q, 0ul, MPFR_RNDN); /* to obtain divisions by 0 later on */ /* now compute b_scaled*conjugate(c_scaled) */ mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ); inexact_re = MPC_INEX_RE (inexact_prod); inexact_im = MPC_INEX_IM (inexact_prod); underflow_prod = mpfr_underflow_p (); overflow_prod = mpfr_overflow_p (); /* unfortunately, does not distinguish between under-/overflow in real or imaginary parts hopefully, the side-effects of mpc_mul do indeed raise the mpfr exceptions */ if (overflow_prod) { /* FIXME: in case overflow_norm is also true, the code below is wrong, since the after division by the norm, we might end up with finite real and/or imaginary parts. A workaround would be to scale the inputs (in case the exponents are within the same range). */ int isinf = 0; /* determine if the real part of res is the maximum or the minimum representable number */ tmpsgn = mpfr_sgn (mpc_realref(res)); if (tmpsgn > 0) { mpfr_nextabove (mpc_realref(res)); isinf = mpfr_inf_p (mpc_realref(res)); mpfr_nextbelow (mpc_realref(res)); } else if (tmpsgn < 0) { mpfr_nextbelow (mpc_realref(res)); isinf = mpfr_inf_p (mpc_realref(res)); mpfr_nextabove (mpc_realref(res)); } if (isinf) { mpfr_set_inf (mpc_realref(res), tmpsgn); overflow_re = 1; } /* same for the imaginary part */ tmpsgn = mpfr_sgn (mpc_imagref(res)); isinf = 0; if (tmpsgn > 0) { mpfr_nextabove (mpc_imagref(res)); isinf = mpfr_inf_p (mpc_imagref(res)); mpfr_nextbelow (mpc_imagref(res)); } else if (tmpsgn < 0) { mpfr_nextbelow (mpc_imagref(res)); isinf = mpfr_inf_p (mpc_imagref(res)); mpfr_nextabove (mpc_imagref(res)); } if (isinf) { mpfr_set_inf (mpc_imagref(res), tmpsgn); overflow_im = 1; } mpc_set (a, res, rnd); goto end; } /* divide the product by the norm */ if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) { /* The division has good chances to be exact in at least one part. */ /* Since this can cause problems when not rounding to the nearest, */ /* we use the division code of mpfr, which handles the situation. */ mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ); underflow_re = mpfr_underflow_p (); overflow_re = mpfr_overflow_p (); ok_re = !inexact_re || underflow_re || overflow_re || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN)); if (ok_re) /* compute imaginary part */ { mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ); underflow_im = mpfr_underflow_p (); overflow_im = mpfr_overflow_p (); ok_im = !inexact_im || underflow_im || overflow_im || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN)); } } else { /* The division is inexact, so for efficiency reasons we invert q */ /* only once and multiply by the inverse. */ if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) { /* if 1/q is inexact, the approximations of the real and imaginary part below will be inexact, unless RE(res) or IM(res) is zero */ inexact_re |= !mpfr_zero_p (mpc_realref (res)); inexact_im |= !mpfr_zero_p (mpc_imagref (res)); } mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ); underflow_re = mpfr_underflow_p (); overflow_re = mpfr_overflow_p (); ok_re = !inexact_re || underflow_re || overflow_re || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN)); if (ok_re) /* compute imaginary part */ { mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ); underflow_im = mpfr_underflow_p (); overflow_im = mpfr_overflow_p (); ok_im = !inexact_im || underflow_im || overflow_im || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN)); } } } while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm && !underflow_prod && !overflow_prod); inex = mpc_set (a, res, rnd); inexact_re = MPC_INEX_RE (inex); inexact_im = MPC_INEX_IM (inex); end: /* fix values and inexact flags in case of overflow/underflow */ /* FIXME: heuristic, certainly does not cover all cases */ if (overflow_re || (underflow_norm && !underflow_prod)) { mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res))); inexact_re = mpfr_sgn (mpc_realref (res)); } else if (underflow_re || (overflow_norm && !overflow_prod)) { inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1; mpfr_set_zero (mpc_realref (a), -inexact_re); } if (overflow_im || (underflow_norm && !underflow_prod)) { mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res))); inexact_im = mpfr_sgn (mpc_imagref (res)); } else if (underflow_im || (overflow_norm && !overflow_prod)) { inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1; mpfr_set_zero (mpc_imagref (a), -inexact_im); } mpc_clear (res); mpfr_clear (q); /* restore underflow and overflow flags from MPFR */ if (saved_underflow) mpfr_set_underflow (); if (saved_overflow) mpfr_set_overflow (); return MPC_INEX (inexact_re, inexact_im); }

static void special_test (void) { int inex; mpf_t x; mpfr_t y; mpfr_init (y); mpf_init (x); mpfr_set_nan (y); mpfr_clear_flags (); mpfr_get_f (x, y, MPFR_RNDN); if (! mpfr_erangeflag_p ()) { printf ("Error: mpfr_get_f(NaN) should raise erange flag\n"); exit (1); } mpfr_set_inf (y, +1); mpfr_clear_flags (); inex = mpfr_get_f (x, y, MPFR_RNDN); if (inex >= 0) { printf ("Error: mpfr_get_f(+Inf) should return a negative ternary" "value\n"); exit (1); } if (! mpfr_erangeflag_p ()) { printf ("Error: mpfr_get_f(+Inf) should raise erange flag\n"); exit (1); } mpfr_set_inf (y, -1); mpfr_clear_flags (); inex = mpfr_get_f (x, y, MPFR_RNDN); if (inex <= 0) { printf ("Error: mpfr_get_f(-Inf) should return a positive ternary" "value\n"); exit (1); } if (! mpfr_erangeflag_p ()) { printf ("Error: mpfr_get_f(-Inf) should raise erange flag\n"); exit (1); } mpfr_set_ui (y, 0, MPFR_RNDN); if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_ui (x, 0)) { printf ("Error: mpfr_get_f(+0) fails\n"); exit (1); } mpfr_set_ui (y, 0, MPFR_RNDN); mpfr_neg (y, y, MPFR_RNDN); if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_ui (x, 0)) { printf ("Error: mpfr_get_f(-0) fails\n"); exit (1); } mpfr_clear (y); mpf_clear (x); }

int main (void) { double x, y; mpfr_t xx, yy; int c; long i; mp_prec_t p; tests_start_mpfr (); mpfr_init (xx); mpfr_init (yy); mpfr_set_prec (xx, 2); mpfr_set_prec (yy, 2); mpfr_set_str_binary(xx, "-0.10E0"); mpfr_set_str_binary(yy, "-0.10E0"); if ((mpfr_cmp) (xx, yy)) { printf ("mpfr_cmp (xx, yy) returns non-zero for prec=2\n"); exit (1); } mpfr_set_prec (xx, 65); mpfr_set_prec (yy, 65); mpfr_set_str_binary(xx, "0.10011010101000110101010000000011001001001110001011101011111011101E623"); mpfr_set_str_binary(yy, "0.10011010101000110101010000000011001001001110001011101011111011100E623"); p = 0; if (mpfr_cmp2 (xx, yy, &p) <= 0 || p != 64) { printf ("Error (1) in mpfr_cmp2\n"); exit (1); } mpfr_set_str_binary(xx, "0.10100010001110110111000010001000010011111101000100011101000011100"); mpfr_set_str_binary(yy, "0.10100010001110110111000010001000010011111101000100011101000011011"); p = 0; if (mpfr_cmp2 (xx, yy, &p) <= 0 || p != 64) { printf ("Error (2) in mpfr_cmp2\n"); exit (1); } mpfr_set_prec (xx, 160); mpfr_set_prec (yy, 160); mpfr_set_str_binary (xx, "0.1E1"); mpfr_set_str_binary (yy, "0.1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111100000110001110100"); p = 0; if (mpfr_cmp2 (xx, yy, &p) <= 0 || p != 144) { printf ("Error (3) in mpfr_cmp2\n"); exit (1); } mpfr_set_prec (xx, 53); mpfr_set_prec (yy, 200); mpfr_set_ui (xx, 1, (mp_rnd_t) 0); mpfr_set_ui (yy, 1, (mp_rnd_t) 0); if (mpfr_cmp (xx, yy) != 0) { printf ("Error in mpfr_cmp: 1.0 != 1.0\n"); exit (1); } mpfr_set_prec (yy, 31); mpfr_set_str (xx, "1.0000000002", 10, (mp_rnd_t) 0); mpfr_set_ui (yy, 1, (mp_rnd_t) 0); if (!(mpfr_cmp (xx,yy)>0)) { printf ("Error in mpfr_cmp: not 1.0000000002 > 1.0\n"); exit (1); } mpfr_set_prec (yy, 53); /* bug found by Gerardo Ballabio */ mpfr_set_ui(xx, 0, GMP_RNDN); mpfr_set_str (yy, "0.1", 10, GMP_RNDN); if ((c = mpfr_cmp (xx, yy)) >= 0) { printf ("Error in mpfr_cmp(0.0, 0.1), gives %d\n", c); exit (1); } mpfr_set_inf (xx, 1); mpfr_set_str (yy, "-23489745.0329", 10, GMP_RNDN); if ((c = mpfr_cmp (xx, yy)) <= 0) { printf ("Error in mpfr_cmp(Infp, 23489745.0329), gives %d\n", c); exit (1); } mpfr_set_inf (xx, 1); mpfr_set_inf (yy, -1); if ((c = mpfr_cmp (xx, yy)) <= 0) { printf ("Error in mpfr_cmp(Infp, Infm), gives %d\n", c); exit (1); } mpfr_set_inf (xx, -1); mpfr_set_inf (yy, 1); if ((c = mpfr_cmp (xx, yy)) >= 0) { printf ("Error in mpfr_cmp(Infm, Infp), gives %d\n", c); exit (1); } mpfr_set_inf (xx, 1); mpfr_set_inf (yy, 1); if ((c = mpfr_cmp (xx, yy)) != 0) { printf ("Error in mpfr_cmp(Infp, Infp), gives %d\n", c); exit (1); } mpfr_set_inf (xx, -1); mpfr_set_inf (yy, -1); if ((c = mpfr_cmp (xx, yy)) != 0) { printf ("Error in mpfr_cmp(Infm, Infm), gives %d\n", c); exit (1); } mpfr_set_inf (xx, -1); mpfr_set_str (yy, "2346.09234", 10, GMP_RNDN); if ((c = mpfr_cmp (xx, yy)) >= 0) { printf ("Error in mpfr_cmp(Infm, 2346.09234), gives %d\n", c); exit (1); } mpfr_set_ui (xx, 0, GMP_RNDN); mpfr_set_ui (yy, 1, GMP_RNDN); if ((c = mpfr_cmp3 (xx, yy, 1)) >= 0) { printf ("Error: mpfr_cmp3 (0, 1, 1) gives %d instead of" " a negative value\n", c); exit (1); } if ((c = mpfr_cmp3 (xx, yy, -1)) <= 0) { printf ("Error: mpfr_cmp3 (0, 1, -1) gives %d instead of" " a positive value\n", c); exit (1); } for (i=0; i<500000; ) { x = DBL_RAND (); y = DBL_RAND (); if (!Isnan(x) && !Isnan(y)) { i++; mpfr_set_d (xx, x, GMP_RNDN); mpfr_set_d (yy, y, GMP_RNDN); c = mpfr_cmp (xx,yy); if ((c>0 && x<=y) || (c==0 && x!=y) || (c<0 && x>=y)) { printf ("Error in mpfr_cmp with x=%1.20e, y=%1.20e" " mpfr_cmp(x,y)=%d\n", x, y, c); exit (1); } } } /* Check for NAN */ mpfr_set_nan (xx); mpfr_clear_erangeflag (); c = (mpfr_cmp) (xx, yy); if (c != 0 || !mpfr_erangeflag_p () ) { printf ("NAN error (1)\n"); exit (1); } mpfr_clear_erangeflag (); c = (mpfr_cmp) (yy, xx); if (c != 0 || !mpfr_erangeflag_p () ) { printf ("NAN error (2)\n"); exit (1); } mpfr_clear_erangeflag (); c = (mpfr_cmp) (xx, xx); if (c != 0 || !mpfr_erangeflag_p () ) { printf ("NAN error (3)\n"); exit (1); } mpfr_clear (xx); mpfr_clear (yy); tests_end_mpfr (); return 0; }

/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6 from Abramowitz & Stegun). Assumes |z| > p log(2)/2, where p is the target precision (z can be negative only for jn). Return 0 if the expansion does not converge enough (the value 0 as inexact flag should not happen for normal input). */ static int FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r) { mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u; mpfr_prec_t w; long k; int inex, stop, diverge = 0; mpfr_exp_t err2, err; MPFR_ZIV_DECL (loop); mpfr_init (c); w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4; MPFR_ZIV_INIT (loop, w); for (;;) { mpfr_set_prec (c, w); mpfr_init2 (s, w); mpfr_init2 (P, w); mpfr_init2 (Q, w); mpfr_init2 (t, w); mpfr_init2 (iz, w); mpfr_init2 (err_t, 31); mpfr_init2 (err_s, 31); mpfr_init2 (err_u, 31); /* Approximate sin(z) and cos(z). In the following, err <= k means that the approximate value y and the true value x are related by y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */ mpfr_sin_cos (s, c, z, MPFR_RNDN); if (MPFR_IS_NEG(z)) mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */ /* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */ mpfr_add (t, s, c, MPFR_RNDN); mpfr_sub (c, s, c, MPFR_RNDN); mpfr_swap (s, t); /* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z), with total absolute error bounded by 2^(1-w). */ /* precompute 1/(8|z|) */ mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN); /* err <= 1 */ mpfr_div_2ui (iz, iz, 3, MPFR_RNDN); /* compute P and Q */ mpfr_set_ui (P, 1, MPFR_RNDN); mpfr_set_ui (Q, 0, MPFR_RNDN); mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */ mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */ mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */ for (k = 1, stop = 0; stop < 4; k++) { /* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */ mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */ mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */ mpfr_div_ui (t, t, k, MPFR_RNDN); /* err <= err_k + 3 */ mpfr_mul (t, t, iz, MPFR_RNDN); /* err <= err_k + 5 */ /* the relative error on t is bounded by (1+u)^(5k)-1, which is bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u| for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */ mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD); mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */ /* the absolute error on t is bounded by err_t * 2^(-w) */ mpfr_abs (err_u, t, MPFR_RNDU); mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */ mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */ if (stop >= 2) { /* take into account the neglected terms: t * 2^w */ mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU); if (MPFR_IS_POS(t)) mpfr_add (err_s, err_s, t, MPFR_RNDU); else mpfr_sub (err_s, err_s, t, MPFR_RNDU); mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU); stop ++; } /* if k is odd, add to Q, otherwise to P */ else if (k & 1) { /* if k = 1 mod 4, add, otherwise subtract */ if ((k & 2) == 0) mpfr_add (Q, Q, t, MPFR_RNDN); else mpfr_sub (Q, Q, t, MPFR_RNDN); /* check if the next term is smaller than ulp(Q): if EXP(err_u) <= EXP(Q), since the current term is bounded by err_u * 2^(-w), it is bounded by ulp(Q) */ if (MPFR_EXP(err_u) <= MPFR_EXP(Q)) stop ++; else stop = 0; } else { /* if k = 0 mod 4, add, otherwise subtract */ if ((k & 2) == 0) mpfr_add (P, P, t, MPFR_RNDN); else mpfr_sub (P, P, t, MPFR_RNDN); /* check if the next term is smaller than ulp(P) */ if (MPFR_EXP(err_u) <= MPFR_EXP(P)) stop ++; else stop = 0; } mpfr_add (err_s, err_s, err_t, MPFR_RNDU); /* the sum of the rounding errors on P and Q is bounded by err_s * 2^(-w) */ /* stop when start to diverge */ if (stop < 2 && ((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) || (MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0))) { /* if we have to stop the series because it diverges, then increasing the precision will most probably fail, since we will stop to the same point, and thus compute a very similar approximation */ diverge = 1; stop = 2; /* force stop */ } } /* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */ /* Now combine: the sum of the rounding errors on P and Q is bounded by err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */ if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn Q * (sin + cos) + P (sin - cos) for yn */ { #ifdef MPFR_JN mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */ mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */ #else mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */ mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */ #endif err = MPFR_EXP(c); if (MPFR_EXP(s) > err) err = MPFR_EXP(s); #ifdef MPFR_JN mpfr_sub (s, s, c, MPFR_RNDN); #else mpfr_add (s, s, c, MPFR_RNDN); #endif } else /* n odd: P * (sin - cos) + Q (cos + sin) for jn, Q * (sin - cos) - P (cos + sin) for yn */ { #ifdef MPFR_JN mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */ mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */ #else mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */ mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */ #endif err = MPFR_EXP(c); if (MPFR_EXP(s) > err) err = MPFR_EXP(s); #ifdef MPFR_JN mpfr_add (s, s, c, MPFR_RNDN); #else mpfr_sub (s, c, s, MPFR_RNDN); #endif } if ((n & 2) != 0) mpfr_neg (s, s, MPFR_RNDN); if (MPFR_EXP(s) > err) err = MPFR_EXP(s); /* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c) + err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1) <= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w), since |c|, |old_s| <= 2. */ err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2; /* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */ err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2; /* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */ err2 = (err >= err2) ? err + 1 : err2 + 1; /* now the absolute error on s is bounded by 2^(err2 - w) */ /* multiply by sqrt(1/(Pi*z)) */ mpfr_const_pi (c, MPFR_RNDN); /* Pi, err <= 1 */ mpfr_mul (c, c, z, MPFR_RNDN); /* err <= 2 */ mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */ mpfr_sqrt (c, c, MPFR_RNDN); /* err<=5/2, thus the absolute error is bounded by 3*u*|c| for |u| <= 0.25 */ mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD); mpfr_abs (err_t, err_t, MPFR_RNDU); mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU); /* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */ err2 += MPFR_EXP(c); /* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */ mpfr_mul (c, c, s, MPFR_RNDN); /* the absolute error on c is bounded by 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| + |old_c| * 2^(err2 - w) */ /* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */ err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1; /* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */ /* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */ err = (err >= err2) ? err + 1 : err2 + 1; /* the absolute error on c is bounded by 2^(err - w) */ mpfr_clear (s); mpfr_clear (P); mpfr_clear (Q); mpfr_clear (t); mpfr_clear (iz); mpfr_clear (err_t); mpfr_clear (err_s); mpfr_clear (err_u); err -= MPFR_EXP(c); if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r))) break; if (diverge != 0) { mpfr_set (c, z, r); /* will force inex=0 below, which means the asymptotic expansion failed */ break; } MPFR_ZIV_NEXT (loop, w); } MPFR_ZIV_FREE (loop); inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r) : mpfr_neg (res, c, r); mpfr_clear (c); return inex; }

static void test_generic_ui (mpfr_prec_t p0, mpfr_prec_t p1, unsigned int N) { mpfr_prec_t prec, yprec; mpfr_t x, y, z, t; INTEGER_TYPE u; mpfr_rnd_t rnd; int inexact, compare, compare2; unsigned int n; mpfr_init (x); mpfr_init (y); mpfr_init (z); mpfr_init (t); /* generic test */ for (prec = p0; prec <= p1; prec++) { mpfr_set_prec (x, prec); mpfr_set_prec (z, prec); mpfr_set_prec (t, prec); yprec = prec + 10; for (n = 0; n <= N; n++) { if (n > 1 || prec < p1) RAND_FUNCTION (x); else { /* Special cases tested in precision p1 if n <= 1. */ mpfr_set_si (x, n == 0 ? 1 : -1, MPFR_RNDN); mpfr_set_exp (x, mpfr_get_emin ()); } u = INT_RAND_FUNCTION (); rnd = RND_RAND (); mpfr_set_prec (y, yprec); compare = TEST_FUNCTION (y, x, u, rnd); if (mpfr_can_round (y, yprec, rnd, rnd, prec)) { mpfr_set (t, y, rnd); inexact = TEST_FUNCTION (z, x, u, rnd); if (mpfr_cmp (t, z)) { printf ("results differ for x="); mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN); printf ("\nu=%lu", (unsigned long) u); printf (" prec=%lu rnd_mode=%s\n", (unsigned long ) prec, mpfr_print_rnd_mode (rnd)); #ifdef TEST_FUNCTION_NAME printf ("Function: %s\n", TEST_FUNCTION_NAME); #endif printf ("got "); mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN); puts (""); printf ("expected "); mpfr_out_str (stdout, 2, prec, t, MPFR_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 (""); printf ("u=%lu", (unsigned long) u); printf ("y="); mpfr_print_binary (y); puts (""); printf ("t="); mpfr_print_binary (t); puts (""); exit (1); } } } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (t); }

/* checks that the inexact return value is correct */ static void check_exact (void) { mpfr_t a, b, c, d; mpfr_prec_t prec; int i, inexact; mpfr_rnd_t rnd; mpfr_init (a); mpfr_init (b); mpfr_init (c); mpfr_init (d); mpfr_set_prec (a, 17); mpfr_set_prec (b, 17); mpfr_set_prec (c, 32); mpfr_set_str_binary (a, "1.1000111011000100e-1"); mpfr_set_str_binary (b, "1.0010001111100111e-1"); if (test_mul (c, a, b, MPFR_RNDZ)) { printf ("wrong return value (1)\n"); exit (1); } for (prec = 2; prec < 100; prec++) { mpfr_set_prec (a, prec); mpfr_set_prec (b, prec); mpfr_set_prec (c, 2 * prec - 2); mpfr_set_prec (d, 2 * prec); for (i = 0; i < 1000; i++) { mpfr_urandomb (a, RANDS); mpfr_urandomb (b, RANDS); rnd = RND_RAND (); inexact = test_mul (c, a, b, rnd); if (test_mul (d, a, b, rnd)) /* should be always exact */ { printf ("unexpected inexact return value\n"); exit (1); } if ((inexact == 0) && mpfr_cmp (c, d)) { printf ("inexact=0 but results differ\n"); exit (1); } else if (inexact && (mpfr_cmp (c, d) == 0)) { printf ("inexact!=0 but results agree\n"); printf ("prec=%u rnd=%s a=", (unsigned int) prec, mpfr_print_rnd_mode (rnd)); mpfr_out_str (stdout, 2, 0, a, rnd); printf ("\nb="); mpfr_out_str (stdout, 2, 0, b, rnd); printf ("\nc="); mpfr_out_str (stdout, 2, 0, c, rnd); printf ("\nd="); mpfr_out_str (stdout, 2, 0, d, rnd); printf ("\n"); exit (1); } } } mpfr_clear (a); mpfr_clear (b); mpfr_clear (c); mpfr_clear (d); }

static void check_inexact (mp_prec_t p) { mpfr_t x, y, z, t; unsigned long u; mp_prec_t q; int inexact, cmp; int rnd; mpfr_init2 (x, p); mpfr_init (y); mpfr_init (z); mpfr_init (t); mpfr_random (x); u = randlimb () % 2; for (q = 2; q <= p; q++) for (rnd = 0; rnd < GMP_RND_MAX; rnd++) { mpfr_set_prec (y, q); mpfr_set_prec (z, q + 10); mpfr_set_prec (t, q); inexact = mpfr_pow_ui (y, x, u, (mp_rnd_t) rnd); cmp = mpfr_pow_ui (z, x, u, (mp_rnd_t) rnd); if (mpfr_can_round (z, q + 10, (mp_rnd_t) rnd, (mp_rnd_t) rnd, q)) { cmp = mpfr_set (t, z, (mp_rnd_t) rnd) || cmp; if (mpfr_cmp (y, t)) { printf ("results differ for u=%lu rnd=%s\n", u, mpfr_print_rnd_mode ((mp_rnd_t) rnd)); printf ("x="); mpfr_print_binary (x); puts (""); printf ("y="); mpfr_print_binary (y); puts (""); printf ("t="); mpfr_print_binary (t); puts (""); printf ("z="); mpfr_print_binary (z); puts (""); exit (1); } if (((inexact == 0) && (cmp != 0)) || ((inexact != 0) && (cmp == 0))) { printf ("Wrong inexact flag for p=%u, q=%u, rnd=%s\n", (unsigned int) p, (unsigned int) q, mpfr_print_rnd_mode ((mp_rnd_t) rnd)); printf ("expected %d, got %d\n", cmp, inexact); printf ("u=%lu x=", u); mpfr_print_binary (x); puts (""); printf ("y="); mpfr_print_binary (y); puts (""); exit (1); } } } /* check exact power */ mpfr_set_prec (x, p); mpfr_set_prec (y, p); mpfr_set_prec (z, p); mpfr_set_ui (x, 4, GMP_RNDN); mpfr_set_str (y, "0.5", 10, GMP_RNDN); test_pow (z, x, y, GMP_RNDZ); mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (t); }

static void special (void) { mpfr_t x, y; mpq_t q; mpz_t z; int res = 0; mpfr_init (x); mpfr_init (y); mpq_init (q); mpz_init (z); /* cancellation in mpfr_add_q */ mpfr_set_prec (x, 60); mpfr_set_prec (y, 20); mpz_set_str (mpq_numref (q), "-187207494", 10); mpz_set_str (mpq_denref (q), "5721", 10); mpfr_set_str_binary (x, "11111111101001011011100101100011011110010011100010000100001E-44"); mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("cancelation in add_q", mpfr_cmp_ui_2exp (y, 256783, -64) == 0); mpfr_set_prec (x, 19); mpfr_set_str_binary (x, "0.1011110101110011100E0"); mpz_set_str (mpq_numref (q), "187207494", 10); mpz_set_str (mpq_denref (q), "5721", 10); mpfr_set_prec (y, 29); mpfr_add_q (y, x, q, MPFR_RNDD); mpfr_set_prec (x, 29); mpfr_set_str_binary (x, "11111111101001110011010001001E-14"); CHECK_FOR ("cancelation in add_q", mpfr_cmp (x,y) == 0); /* Inf */ mpfr_set_inf (x, 1); mpz_set_str (mpq_numref (q), "395877315", 10); mpz_set_str (mpq_denref (q), "3508975966", 10); mpfr_set_prec (y, 118); mpfr_add_q (y, x, q, MPFR_RNDU); CHECK_FOR ("inf", mpfr_inf_p (y) && mpfr_sgn (y) > 0); mpfr_sub_q (y, x, q, MPFR_RNDU); CHECK_FOR ("inf", mpfr_inf_p (y) && mpfr_sgn (y) > 0); /* Nan */ MPFR_SET_NAN (x); mpfr_add_q (y, x, q, MPFR_RNDU); CHECK_FOR ("nan", mpfr_nan_p (y)); mpfr_sub_q (y, x, q, MPFR_RNDU); CHECK_FOR ("nan", mpfr_nan_p (y)); /* Exact value */ mpfr_set_prec (x, 60); mpfr_set_prec (y, 60); mpfr_set_str1 (x, "0.5"); mpz_set_str (mpq_numref (q), "3", 10); mpz_set_str (mpq_denref (q), "2", 10); res = mpfr_add_q (y, x, q, MPFR_RNDU); CHECK_FOR ("0.5+3/2", mpfr_cmp_ui(y, 2)==0 && res==0); res = mpfr_sub_q (y, x, q, MPFR_RNDU); CHECK_FOR ("0.5-3/2", mpfr_cmp_si(y, -1)==0 && res==0); /* Inf Rationnal */ mpq_set_ui (q, 1, 0); mpfr_set_str1 (x, "0.5"); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("0.5+1/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("0.5-1/0", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0); mpq_set_si (q, -1, 0); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("0.5+ -1/0", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("0.5- -1/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0); res = mpfr_div_q (y, x, q, MPFR_RNDN); CHECK_FOR ("0.5 / (-1/0)", mpfr_zero_p (y) && MPFR_IS_NEG (y) && res == 0); mpq_set_ui (q, 1, 0); mpfr_set_inf (x, 1); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("+Inf + +Inf", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("+Inf - +Inf", MPFR_IS_NAN (y) && res == 0); mpfr_set_inf (x, -1); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("-Inf + +Inf", MPFR_IS_NAN (y) && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("-Inf - +Inf", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0); mpq_set_si (q, -1, 0); mpfr_set_inf (x, 1); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("+Inf + -Inf", MPFR_IS_NAN (y) && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("+Inf - -Inf", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0); mpfr_set_inf (x, -1); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("-Inf + -Inf", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("-Inf - -Inf", MPFR_IS_NAN (y) && res == 0); /* 0 */ mpq_set_ui (q, 0, 1); mpfr_set_ui (x, 42, MPFR_RNDN); res = mpfr_add_q (y, x, q, MPFR_RNDN); CHECK_FOR ("42+0/1", mpfr_cmp_ui (y, 42) == 0 && res == 0); res = mpfr_sub_q (y, x, q, MPFR_RNDN); CHECK_FOR ("42-0/1", mpfr_cmp_ui (y, 42) == 0 && res == 0); res = mpfr_mul_q (y, x, q, MPFR_RNDN); CHECK_FOR ("42*0/1", mpfr_zero_p (y) && MPFR_IS_POS (y) && res == 0); mpfr_clear_flags (); res = mpfr_div_q (y, x, q, MPFR_RNDN); CHECK_FOR ("42/(0/1)", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0 && mpfr_divby0_p ()); mpz_set_ui (z, 0); mpfr_clear_flags (); res = mpfr_div_z (y, x, z, MPFR_RNDN); CHECK_FORZ ("42/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0 && mpfr_divby0_p ()); mpz_clear (z); mpq_clear (q); mpfr_clear (x); mpfr_clear (y); }

int main (void) { mpf_t x; mpfr_t y, z; unsigned long i; mpfr_exp_t e; int inex; tests_start_mpfr (); mpfr_init (y); mpfr_init (z); mpf_init (x); i = 1; while (i) { mpfr_set_ui (y, i, MPFR_RNDN); if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_ui (x, i)) { printf ("Error: mpfr_get_f(%lu) fails\n", i); exit (1); } if (i <= - (unsigned long) LONG_MIN) { long j = i < - (unsigned long) LONG_MIN ? - (long) i : LONG_MIN; mpfr_set_si (y, j, MPFR_RNDN); if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_si (x, j)) { printf ("Error: mpfr_get_f(-%lu) fails\n", i); exit (1); } } i *= 2; } /* same tests, but with a larger precision for y, which requires to round it */ mpfr_set_prec (y, 100); i = 1; while (i) { mpfr_set_ui (y, i, MPFR_RNDN); inex = mpfr_get_f (x, y, MPFR_RNDN); if (! SAME_SIGN (inex, - mpfr_cmp_f (y, x)) || mpf_cmp_ui (x, i)) { printf ("Error: mpfr_get_f(%lu) fails\n", i); exit (1); } mpfr_set_si (y, (signed long) -i, MPFR_RNDN); inex = mpfr_get_f (x, y, MPFR_RNDN); if (! SAME_SIGN (inex, - mpfr_cmp_f (y, x)) || mpf_cmp_si (x, (signed long) -i)) { printf ("Error: mpfr_get_f(-%lu) fails\n", i); exit (1); } i *= 2; } /* bug reported by Jim White */ for (e = 0; e <= 2 * GMP_NUMB_BITS; e++) { /* test with 2^(-e) */ mpfr_set_ui (y, 1, MPFR_RNDN); mpfr_div_2exp (y, y, e, MPFR_RNDN); inex = mpfr_get_f (x, y, MPFR_RNDN); mpf_mul_2exp (x, x, e); if (inex != 0 || mpf_cmp_ui (x, 1) != 0) { printf ("Error: mpfr_get_f(x,y,MPFR_RNDN) fails\n"); printf ("y="); mpfr_dump (y); printf ("x="); mpf_div_2exp (x, x, e); mpf_out_str (stdout, 2, 0, x); exit (1); } /* test with 2^(e) */ mpfr_set_ui (y, 1, MPFR_RNDN); mpfr_mul_2exp (y, y, e, MPFR_RNDN); inex = mpfr_get_f (x, y, MPFR_RNDN); mpf_div_2exp (x, x, e); if (inex != 0 || mpf_cmp_ui (x, 1) != 0) { printf ("Error: mpfr_get_f(x,y,MPFR_RNDN) fails\n"); printf ("y="); mpfr_dump (y); printf ("x="); mpf_mul_2exp (x, x, e); mpf_out_str (stdout, 2, 0, x); exit (1); } } /* Bug reported by Yury Lukach on 2006-04-05 */ mpfr_set_prec (y, 32); mpfr_set_prec (z, 32); mpf_set_prec (x, 32); mpfr_set_ui_2exp (y, 0xc1234567, -30, MPFR_RNDN); mpfr_get_f (x, y, MPFR_RNDN); inex = mpfr_set_f (z, x, MPFR_RNDN); if (inex != 0 || ! mpfr_equal_p (y, z)) { printf ("Error in mpfr_get_f:\n inex = %d, y = ", inex); mpfr_dump (z); printf ("Expected:\n inex = 0, y = "); mpfr_dump (y); exit (1); } mpfr_clear (y); mpfr_clear (z); mpf_clear (x); special_test (); prec_test (); ternary_test (); tests_end_mpfr (); return 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); }

int mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd) { int ok; mpfr_t u, v; mpfr_t x; /* temporary variable to hold the real part of op, needed in the case rop==op */ mpfr_prec_t prec; int inex_re, inex_im, inexact; mpfr_exp_t emin; int saved_underflow; /* special values: NaN and infinities */ if (!mpc_fin_p (op)) { if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) { mpfr_set_nan (mpc_realref (rop)); mpfr_set_nan (mpc_imagref (rop)); } else if (mpfr_inf_p (mpc_realref (op))) { if (mpfr_inf_p (mpc_imagref (op))) { mpfr_set_inf (mpc_imagref (rop), MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op))); mpfr_set_nan (mpc_realref (rop)); } else { if (mpfr_zero_p (mpc_imagref (op))) mpfr_set_nan (mpc_imagref (rop)); else mpfr_set_inf (mpc_imagref (rop), MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op))); mpfr_set_inf (mpc_realref (rop), +1); } } else /* IM(op) is infinity, RE(op) is not */ { if (mpfr_zero_p (mpc_realref (op))) mpfr_set_nan (mpc_imagref (rop)); else mpfr_set_inf (mpc_imagref (rop), MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op))); mpfr_set_inf (mpc_realref (rop), -1); } return MPC_INEX (0, 0); /* exact */ } prec = MPC_MAX_PREC(rop); /* Check for real resp. purely imaginary number */ if (mpfr_zero_p (mpc_imagref(op))) { int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op)); inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd)); inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN); if (!same_sign) mpc_conj (rop, rop, MPC_RNDNN); return MPC_INEX(inex_re, inex_im); } if (mpfr_zero_p (mpc_realref(op))) { int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op)); inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd))); mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN); inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN); if (!same_sign) mpc_conj (rop, rop, MPC_RNDNN); return MPC_INEX(inex_re, inex_im); } if (rop == op) { mpfr_init2 (x, MPC_PREC_RE (op)); mpfr_set (x, op->re, MPFR_RNDN); } else x [0] = op->re [0]; /* From here on, use x instead of op->re and safely overwrite rop->re. */ /* Compute real part of result. */ if (SAFE_ABS (mpfr_exp_t, mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op))) > (mpfr_exp_t) MPC_MAX_PREC (op) / 2) { /* If the real and imaginary parts of the argument have very different exponents, it is not reasonable to use Karatsuba squaring; compute exactly with the standard formulae instead, even if this means an additional multiplication. Using the approach copied from mul, over- and underflows are also handled correctly. */ inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd)); } else { /* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the naive algorithm, which computes x^2-y^2 and 2*y*y */ mpfr_init (u); mpfr_init (v); emin = mpfr_get_emin (); do { prec += mpc_ceil_log2 (prec) + 5; mpfr_set_prec (u, prec); mpfr_set_prec (v, prec); /* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */ /* The error is bounded above by 1 ulp. */ /* We first let inexact be 1 if the real part is not computed */ /* exactly and determine the sign later. */ inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA) | mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA); /* compute the real part as u*v, rounded away */ /* determine also the sign of inex_re */ if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) { /* as we have rounded away, the result is exact */ mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN); inex_re = 0; ok = 1; } else { inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */ if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) { /* under- or overflow */ inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd)); ok = 1; } else { ok = (!inexact) | mpfr_can_round (u, prec - 3, MPFR_RNDA, MPFR_RNDZ, MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN)); if (ok) { inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd)); if (inex_re == 0) /* remember that u was already rounded */ inex_re = inexact; } } } } while (!ok); mpfr_clear (u); mpfr_clear (v); } saved_underflow = mpfr_underflow_p (); mpfr_clear_underflow (); inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd)); if (!mpfr_underflow_p ()) inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd)); /* We must not multiply by 2 if rop->im has been set to the smallest representable number. */ if (saved_underflow) mpfr_set_underflow (); if (rop == op) mpfr_clear (x); return MPC_INEX (inex_re, inex_im); }

int main (int argc, char *argv[]) { mpfr_t x; int p; mpfr_rnd_t rnd; tests_start_mpfr (); p = (argc>1) ? atoi(argv[1]) : 53; rnd = (argc>2) ? (mpfr_rnd_t) atoi(argv[2]) : MPFR_RNDZ; mpfr_init (x); check (2, 1000); /* check precision of 2 bits */ mpfr_set_prec (x, 2); mpfr_const_log2 (x, MPFR_RNDN); if (mpfr_cmp_ui_2exp(x, 3, -2)) /* 3*2^-2 */ { printf ("mpfr_const_log2 failed for prec=2, rnd=MPFR_RNDN\n" "expected 0.75, got "); mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n'); exit (1); } if (argc>=2) { mpfr_set_prec (x, p); mpfr_const_log2 (x, rnd); printf ("log(2)="); mpfr_out_str (stdout, 10, 0, x, rnd); puts (""); } mpfr_set_prec (x, 53); mpfr_const_log2 (x, MPFR_RNDZ); if (mpfr_cmp_str1 (x, "6.9314718055994530941e-1") ) { printf ("mpfr_const_log2 failed for prec=53\n"); exit (1); } mpfr_set_prec (x, 32); mpfr_const_log2 (x, MPFR_RNDN); if (mpfr_cmp_str1 (x, "0.69314718060195446")) { printf ("mpfr_const_log2 failed for prec=32\n"); exit (1); } mpfr_clear(x); check_large(); check_cache (); test_generic (2, 200, 1); tests_end_mpfr (); return 0; }

int main (int argc, char *argv[]) { mpfr_t x, y, z; mpfr_prec_t prec, yprec; mpfr_t t, s; mpfr_rnd_t rnd; int inexact, compare, compare2; unsigned int n, err; mpfr_prec_t p0=2, p1=100; unsigned int N=25; tests_start_mpfr (); mpfr_init (x); mpfr_init2 (y,sizeof(unsigned long int)*CHAR_BIT); mpfr_init (z); mpfr_init (s); mpfr_init (t); /* generic test */ for (prec = p0; prec <= p1; prec++) { mpfr_set_prec (x, prec); mpfr_set_prec (s, sizeof(unsigned long int)*CHAR_BIT); mpfr_set_prec (z, prec); mpfr_set_prec (t, prec); yprec = prec + 10; for (n=0; n<N; n++) { mpfr_urandomb (x, RANDS); mpfr_urandomb (s, RANDS); if (randlimb () % 2) mpfr_neg (s, s, MPFR_RNDN); rnd = RND_RAND (); mpfr_set_prec (y, yprec); compare = mpfr_pow (y, x, s, rnd); err = (rnd == MPFR_RNDN) ? yprec + 1 : yprec; if (mpfr_can_round (y, err, rnd, rnd, prec)) { mpfr_set (t, y, rnd); inexact = mpfr_pow (z, x, s, rnd); if (mpfr_cmp (t, z)) { printf ("results differ for x^y with x="); mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN); printf (" y="); mpfr_out_str (stdout, 2, 0, s, MPFR_RNDN); printf (" prec=%u rnd_mode=%s\n", (unsigned int) prec, mpfr_print_rnd_mode (rnd)); printf ("got "); mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN); puts (""); printf ("expected "); mpfr_out_str (stdout, 2, prec, t, MPFR_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 ((rnd != MPFR_RNDN) && (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 (""); printf ("y="); mpfr_print_binary (y); puts (""); printf ("t="); mpfr_print_binary (t); puts (""); exit (1); } } } } mpfr_clear (s); mpfr_clear (t); mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); tests_end_mpfr (); return 0; }

int main (void) { mpfr_t x; tests_start_mpfr (); mpfr_init (x); /* check +infinity gives non-zero for mpfr_inf_p only */ mpfr_set_ui (x, 1L, MPFR_RNDZ); mpfr_div_ui (x, x, 0L, MPFR_RNDZ); if (mpfr_nan_p (x) || (mpfr_nan_p) (x) ) { printf ("Error: mpfr_nan_p(+Inf) gives non-zero\n"); exit (1); } if (mpfr_inf_p (x) == 0) { printf ("Error: mpfr_inf_p(+Inf) gives zero\n"); exit (1); } if (mpfr_number_p (x) || (mpfr_number_p) (x) ) { printf ("Error: mpfr_number_p(+Inf) gives non-zero\n"); exit (1); } if (mpfr_zero_p (x) || (mpfr_zero_p) (x) ) { printf ("Error: mpfr_zero_p(+Inf) gives non-zero\n"); exit (1); } if (mpfr_regular_p (x) || (mpfr_regular_p) (x) ) { printf ("Error: mpfr_regular_p(+Inf) gives non-zero\n"); exit (1); } /* same for -Inf */ mpfr_neg (x, x, MPFR_RNDN); if (mpfr_nan_p (x) || (mpfr_nan_p(x))) { printf ("Error: mpfr_nan_p(-Inf) gives non-zero\n"); exit (1); } if (mpfr_inf_p (x) == 0) { printf ("Error: mpfr_inf_p(-Inf) gives zero\n"); exit (1); } if (mpfr_number_p (x) || (mpfr_number_p)(x) ) { printf ("Error: mpfr_number_p(-Inf) gives non-zero\n"); exit (1); } if (mpfr_zero_p (x) || (mpfr_zero_p)(x) ) { printf ("Error: mpfr_zero_p(-Inf) gives non-zero\n"); exit (1); } if (mpfr_regular_p (x) || (mpfr_regular_p) (x) ) { printf ("Error: mpfr_regular_p(-Inf) gives non-zero\n"); exit (1); } /* same for NaN */ mpfr_sub (x, x, x, MPFR_RNDN); if (mpfr_nan_p (x) == 0) { printf ("Error: mpfr_nan_p(NaN) gives zero\n"); exit (1); } if (mpfr_inf_p (x) || (mpfr_inf_p)(x) ) { printf ("Error: mpfr_inf_p(NaN) gives non-zero\n"); exit (1); } if (mpfr_number_p (x) || (mpfr_number_p) (x) ) { printf ("Error: mpfr_number_p(NaN) gives non-zero\n"); exit (1); } if (mpfr_zero_p (x) || (mpfr_zero_p)(x) ) { printf ("Error: mpfr_number_p(NaN) gives non-zero\n"); exit (1); } if (mpfr_regular_p (x) || (mpfr_regular_p) (x) ) { printf ("Error: mpfr_regular_p(NaN) gives non-zero\n"); exit (1); } /* same for a regular number */ mpfr_set_ui (x, 1, MPFR_RNDN); if (mpfr_nan_p (x) || (mpfr_nan_p)(x)) { printf ("Error: mpfr_nan_p(1) gives non-zero\n"); exit (1); } if (mpfr_inf_p (x) || (mpfr_inf_p)(x) ) { printf ("Error: mpfr_inf_p(1) gives non-zero\n"); exit (1); } if (mpfr_number_p (x) == 0) { printf ("Error: mpfr_number_p(1) gives zero\n"); exit (1); } if (mpfr_zero_p (x) || (mpfr_zero_p) (x) ) { printf ("Error: mpfr_zero_p(1) gives non-zero\n"); exit (1); } if (mpfr_regular_p (x) == 0 || (mpfr_regular_p) (x) == 0) { printf ("Error: mpfr_regular_p(1) gives zero\n"); exit (1); } /* Same for +0 */ mpfr_set_ui (x, 0, MPFR_RNDN); if (mpfr_nan_p (x) || (mpfr_nan_p)(x)) { printf ("Error: mpfr_nan_p(+0) gives non-zero\n"); exit (1); } if (mpfr_inf_p (x) || (mpfr_inf_p)(x) ) { printf ("Error: mpfr_inf_p(+0) gives non-zero\n"); exit (1); } if (mpfr_number_p (x) == 0) { printf ("Error: mpfr_number_p(+0) gives zero\n"); exit (1); } if (mpfr_zero_p (x) == 0 ) { printf ("Error: mpfr_zero_p(+0) gives zero\n"); exit (1); } if (mpfr_regular_p (x) || (mpfr_regular_p) (x) ) { printf ("Error: mpfr_regular_p(+0) gives non-zero\n"); exit (1); } /* Same for -0 */ mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_neg (x, x, MPFR_RNDN); if (mpfr_nan_p (x) || (mpfr_nan_p)(x)) { printf ("Error: mpfr_nan_p(-0) gives non-zero\n"); exit (1); } if (mpfr_inf_p (x) || (mpfr_inf_p)(x) ) { printf ("Error: mpfr_inf_p(-0) gives non-zero\n"); exit (1); } if (mpfr_number_p (x) == 0) { printf ("Error: mpfr_number_p(-0) gives zero\n"); exit (1); } if (mpfr_zero_p (x) == 0 ) { printf ("Error: mpfr_zero_p(-0) gives zero\n"); exit (1); } if (mpfr_regular_p (x) || (mpfr_regular_p) (x) ) { printf ("Error: mpfr_regular_p(-0) gives non-zero\n"); exit (1); } mpfr_clear (x); tests_end_mpfr (); return 0; }

static void check_mixed (void) { int ch = 'a'; #ifndef NPRINTF_HH signed char sch = -1; unsigned char uch = 1; #endif short sh = -1; unsigned short ush = 1; int i = -1; int j = 1; unsigned int ui = 1; long lo = -1; unsigned long ulo = 1; float f = -1.25; double d = -1.25; #if !defined(NPRINTF_T) || !defined(NPRINTF_L) long double ld = -1.25; #endif #ifndef NPRINTF_T ptrdiff_t p = 1, saved_p; #endif size_t sz = 1; mpz_t mpz; mpq_t mpq; mpf_t mpf; mpfr_rnd_t rnd = MPFR_RNDN; mpfr_t mpfr; mpfr_prec_t prec; mpz_init (mpz); mpz_set_ui (mpz, ulo); mpq_init (mpq); mpq_set_si (mpq, lo, ulo); mpf_init (mpf); mpf_set_q (mpf, mpq); mpfr_init (mpfr); mpfr_set_f (mpfr, mpf, MPFR_RNDN); prec = mpfr_get_prec (mpfr); check_vprintf ("a. %Ra, b. %u, c. %lx%n", mpfr, ui, ulo, &j); check_length (1, j, 22, d); check_vprintf ("a. %c, b. %Rb, c. %u, d. %li%ln", i, mpfr, i, lo, &ulo); check_length (2, ulo, 36, lu); check_vprintf ("a. %hi, b. %*f, c. %Re%hn", ush, 3, f, mpfr, &ush); check_length (3, ush, 29, hu); check_vprintf ("a. %hi, b. %f, c. %#.2Rf%n", sh, d, mpfr, &i); check_length (4, i, 29, d); check_vprintf ("a. %R*A, b. %Fe, c. %i%zn", rnd, mpfr, mpf, sz, &sz); check_length (5, (unsigned long) sz, 34, lu); /* no format specifier '%zu' in C89 */ check_vprintf ("a. %Pu, b. %c, c. %RUG, d. %Zi%Zn", prec, ch, mpfr, mpz, &mpz); check_length_with_cmp (6, mpz, 24, mpz_cmp_ui (mpz, 24), Zi); check_vprintf ("%% a. %#.0RNg, b. %Qx%Rn c. %p", mpfr, mpq, &mpfr, (void *) &i); check_length_with_cmp (7, mpfr, 15, mpfr_cmp_ui (mpfr, 15), Rg); #ifndef NPRINTF_T saved_p = p; check_vprintf ("%% a. %RNg, b. %Qx, c. %td%tn", mpfr, mpq, p, &p); if (p != 20) mpfr_fprintf (stderr, "Error in test 8, got '%% a. %RNg, b. %Qx, c. %td'\n", mpfr, mpq, saved_p); check_length (8, (long) p, 20, ld); /* no format specifier '%td' in C89 */ #endif #ifndef NPRINTF_L check_vprintf ("a. %RA, b. %Lf, c. %QX%zn", mpfr, ld, mpq, &sz); check_length (9, (unsigned long) sz, 30, lu); /* no format specifier '%zu' in C89 */ #endif #ifndef NPRINTF_HH check_vprintf ("a. %hhi, b. %Ra, c. %hhu%hhn", sch, mpfr, uch, &uch); check_length (10, (unsigned int) uch, 22, u); /* no format specifier '%hhu' in C89 */ #endif #if defined(HAVE_LONG_LONG) && !defined(NPRINTF_LL) { long long llo = -1; unsigned long long ullo = 1; check_vprintf ("a. %Re, b. %llx%Qn", mpfr, ullo, &mpq); check_length_with_cmp (11, mpq, 16, mpq_cmp_ui (mpq, 16, 1), Qu); check_vprintf ("a. %lli, b. %Rf%lln", llo, mpfr, &ullo); check_length (12, ullo, 19, llu); } #endif #if defined(_MPFR_H_HAVE_INTMAX_T) && !defined(NPRINTF_J) { intmax_t im = -1; uintmax_t uim = 1; check_vprintf ("a. %*RA, b. %ji%Fn", 10, mpfr, im, &mpf); check_length_with_cmp (31, mpf, 20, mpf_cmp_ui (mpf, 20), Fg); check_vprintf ("a. %.*Re, b. %jx%jn", 10, mpfr, uim, &im); check_length (32, (long) im, 25, li); /* no format specifier "%ji" in C89 */ } #endif mpfr_clear (mpfr); mpf_clear (mpf); mpq_clear (mpq); mpz_clear (mpz); }

static void check_overflow (void) { mpfr_t x; char *s; mpfr_init (x); /* Huge overflow */ mpfr_strtofr (x, "123456789E2147483646", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (1) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "123456789E9223372036854775807", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (2) with:\n s='%s'\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "123456789E170141183460469231731687303715884105728", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (3) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } /* Limit overflow */ mpfr_strtofr (x, "12E2147483646", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (4) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "12E2147483645", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (5) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "[email protected]", &s, 16, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (6) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "[email protected]", &s, 16, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (7) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } /* Check underflow */ mpfr_strtofr (x, "123456789E-2147483646", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x) ) { printf ("Check underflow failed (1) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "123456789E-9223372036854775807", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x) ) { printf ("Check underflow failed (2) with:\n s='%s'\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "-123456789E-170141183460469231731687303715884105728", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_NEG (x) ) { printf ("Check underflow failed (3) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "[email protected]", &s, 16, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (7) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_clear (x); }

static void check_hard (void) { mpfr_t u, v, q, q2; mp_prec_t precu, precv, precq; int rnd; int inex, inex2, i, j; mpfr_init (q); mpfr_init (q2); mpfr_init (u); mpfr_init (v); for (precq = MPFR_PREC_MIN; precq <= 64; precq ++) { mpfr_set_prec (q, precq); mpfr_set_prec (q2, precq + 1); for (j = 0; j < 2; j++) { if (j == 0) { do { mpfr_random (q2); } while (mpfr_cmp_ui (q2, 0) == 0); } else /* use q2=1 */ mpfr_set_ui (q2, 1, GMP_RNDN); for (precv = precq; precv <= 10 * precq; precv += precq) { mpfr_set_prec (v, precv); do { mpfr_random (v); } while (mpfr_cmp_ui (v, 0) == 0); for (precu = precq; precu <= 10 * precq; precu += precq) { mpfr_set_prec (u, precu); mpfr_mul (u, v, q2, GMP_RNDN); mpfr_nextbelow (u); for (i = 0; i <= 2; i++) { for (rnd = 0; rnd < GMP_RND_MAX; rnd++) { inex = test_div (q, u, v, (mp_rnd_t) rnd); inex2 = get_inexact (q, u, v); if (inex_cmp (inex, inex2)) { printf ("Wrong inexact flag for rnd=%s: expected %d, got %d\n", mpfr_print_rnd_mode ((mp_rnd_t) rnd), inex2, inex); printf ("u= "); mpfr_dump (u); printf ("v= "); mpfr_dump (v); printf ("q= "); mpfr_dump (q); mpfr_set_prec (q2, precq + precv); mpfr_mul (q2, q, v, GMP_RNDN); printf ("q*v="); mpfr_dump (q2); exit (1); } } mpfr_nextabove (u); } } } } } mpfr_clear (q); mpfr_clear (q2); mpfr_clear (u); mpfr_clear (v); }

/****************************************************************************** One forward-backward pass through a minimum-duration HMM model with a single Gaussian in each of the states. T: totalFeatures *******************************************************************************/ double ESHMM::mdHMMLogForwardBackward(ESHMM *mdHMM, VECTOR_OF_F_VECTORS *features, double **post, int T, mat &gamma, rowvec &gamma1, mat &sumxi){ printf("forward backward algorithm calculation in progress...\n"); int i = 0, j = 0 , k = 0; /* total no of states is much larger, instead of number of pdfs we have to extend states by Min_DUR, therefore total states = Q * MD */ int Q = mdHMM->hmmStates; int Qmd = Q * MIN_DUR; mat logalpha(T, Qmd); // forward probability matrix mat logbeta(T, Qmd); // backward probability matrix mat logg(T, Qmd); // loggamma mat m(Q, 1); mat logA(Qmd, Qmd); /// transition matrix is already in logarithm mat new_logp(T, Qmd); // after replication for each substates mat logp_k(Q, T); // we have single cluster only, probability of each feature corresponding to each cluster printf("Q: %d Qmd: %d\n", Q, Qmd); for(i = 0; i < Qmd; i++){ for(j = 0; j < Qmd; j++){ logA(i, j) = mdHMM->trans[i]->array[j]; } } // minimum duration viterbi hence modify B(posterior) prob matrix for(i = 0; i < Q; i++) for(j = 0; j < T; j++){ logp_k(i, j) = post[i][j]; } for(i = 0; i < Q; i++){ m(i, 0) = 1; for(j = 0; j < T; j++) logp_k(i, j) = 0.0; // since we have only one cluster so cluster probability and // total probability is same. Hence subtracting cluster probability from total probability would make it zero. } // modifying logp matrix according to minimum duration for(i = 0; i < Q; i++){ for(j = 0; j < T; j++){ for(k = i*MIN_DUR; k < (i+1)*MIN_DUR; k++){ new_logp(j, k) = post[i][j]; } } } /* forward initialization */ // for summing log probabilties, first sum probs and then take logarithm printf("forward initialization...\n\n"); for(i = 0; i < Qmd; i++){ logalpha(0, i) = mdHMM->prior->array[i] + new_logp(0, i) ; } ///print logalpha after initialization for(i = 0; i < Qmd; i++) printf("%lf ", logalpha(0, i)); /* forward induction */ printf("forward induction in progress...\n"); int t = 0; mpfr_t summation3; mpfr_init(summation3); mpfr_t var11, var21; mpfr_init(var11); mpfr_init(var21); mpfr_set_d(var11, 0.0, MPFR_RNDN); mpfr_set_d(var21, 0.0, MPFR_RNDN); mpfr_set_d(summation3, 0.0, MPFR_RNDN); for(t = 1; t < T; t++){ //printf("%d ", t); for(j = 0; j < Qmd; j++){ vec v1(Qmd), v2(Qmd); vec v3(Qmd); //first find logalpha vector for(i = 0; i < Qmd; i++) v1(i) = logalpha(t-1, i); // if(t < 20) // v1.print("v1:\n"); // extract transition probability vector for(i = 0; i < Qmd; i++) v2(i) = logA(i, j); // if(t < 20) // v2.print("v2:\n"); // Now sum both the vectors into one for(i = 0; i < Qmd; i++) v3(i) = v1(i) + v2(i); double *temp = (double *)calloc(Qmd, sizeof(double )); for(i = 0; i < Qmd; i++) temp[i] = v3(i); // if(t < 20) // v3.print("v3:\n"); //printf("printed\n"); // now sum over whole column vector mpfr_set_d(summation3, 0.0, MPFR_RNDN); // take the exponentiation and summation in one loop // getting double from mpfr variable /// double mpfr_get_d(mpfr_t op, mpfr_rnd_t rnd); //mpfr_set_d(var1, 0.0, MPFR_RNDD); //mpfr_set_d(var2, 0.0, MPFR_RNDD); // now take the exponentiation for(i = 0; i < Qmd; i++){ double elem = temp[i]; mpfr_set_d(var21, elem, MPFR_RNDD); //mpfr_printf("var2: %lf\n", var21); mpfr_exp(var11, var21, MPFR_RNDD); ///take exp(v2) and store in v1 // take sum of all elements in total mpfr_add(summation3, summation3, var11, MPFR_RNDD); // add summation and v1 } // now take the logarithm of sum mpfr_log(summation3, summation3, MPFR_RNDD); // now convert this sum to double double sum2 = mpfr_get_d(summation3, MPFR_RNDD); // now assign this double to logalpha // now add logp(t, j) sum2 += new_logp(t, j); // if(t < 20) // printf("sum: %lf\n", sum2); logalpha(t, j) = sum2; /// clear mpfr variables } if(t < 20){ printf("logalpha:\n"); for(j = 0; j < Qmd; j++) printf("%lf ", logalpha(t, j)); printf("\n"); } } // close the forward induction loop mpfr_clear(var11); mpfr_clear(var21); mpfr_clear(summation3); /* forward termination */ double ll = 0; // total log likelihood of all observation given this HMM for(i = 0; i < Qmd; i++){ ll += logalpha(T-1, i); } ///=================================================================== // for(i = 0; i < 100; i++){ // for(j = 0; j < Qmd; j++) // printf("%lf ", logalpha(i, j)); // printf("\n"); // } printf("\nprinting last column of logalpha...\n"); for(i = 1; i < 6; i++){ for(j = 0; j < Qmd; j++) printf("%lf ", logalpha(T-i, j)); printf("\n"); } printf("total loglikelihood: %lf\n", ll); ///=================================================================== double sum = 0; /* calculate logalpha last row sum */ for(i = 0; i < Qmd; i++) sum += logalpha(T-1, i); ll = sum; printf("LL: %lf........\n", ll); /* backward initilization */ /// intialize mpfr variables mpfr_t summation; mpfr_init(summation); mpfr_t var1, var2; mpfr_init(var1); mpfr_init(var2); mpfr_set_d(summation, 0.0, MPFR_RNDN); mpfr_set_d(var1, 0.0, MPFR_RNDN); mpfr_set_d(var2, 0.0, MPFR_RNDN); printf("backward initialization...\n"); mpfr_set_d(summation, 0.0, MPFR_RNDN); double *temp = (double *)calloc(Qmd, sizeof(double )); for(i = 0; i < Qmd; i++) temp[i] = logalpha(T-1, i); for(i = 0; i < Qmd; i++){ //double elem = logalpha(T-1, i); double elem = temp[i-1]; mpfr_set_d(var2, elem, MPFR_RNDN); mpfr_exp(var1, var2, MPFR_RNDN); mpfr_add(summation, summation, var1, MPFR_RNDN); } // take logarithm mpfr_log(summation, summation, MPFR_RNDN); double sum2 = mpfr_get_d(summation, MPFR_RNDN); for(i = 0; i < Qmd; i++){ logg(T-1, i) = logalpha(T-1, i) - sum2 ; } // gamma matrix for(j = 0; j < Q; j++){ gamma(j, T-1) = exp(logp_k(j, T-1) + logg(T-1, j)); } mat lognewxi(Qmd, Qmd); // declare lognewxi matrix /* backward induction */ printf("backward induction in progress...\n"); for(t = T-2; t >= 0 ; t--){ for(j = 0; j < Qmd; j++){ vec v1(Qmd); vec v2(Qmd); vec v3(Qmd); sum = 0; for(i = 0; i < Qmd; i++) v1(i) = logA(j, i); for(i = 0; i < Qmd; i++) v2(i) = logbeta(t+1, i); for(i = 0; i < Qmd; i++) v3(i) = new_logp(t+1, i); // add all three vectors for(i = 0; i < Qmd; i++) v1(i) += v2(i) + v3(i); mpfr_set_d(summation, 0.0, MPFR_RNDN); for(i = 0; i < Qmd; i++){ double elem = v1(i); mpfr_set_d(var2, elem, MPFR_RNDN); mpfr_exp(var1, var2, MPFR_RNDN); mpfr_add(summation, summation, var1, MPFR_RNDN); } mpfr_log(summation, summation, MPFR_RNDN); sum2 = mpfr_get_d(summation, MPFR_RNDN); logbeta(t, j) = sum2; } // computation of log(gamma) is now possible called logg here for(i = 0; i < Qmd; i++){ logg(t, i) = logalpha(t, i) + logbeta(t, i); } mpfr_set_d(summation, 0.0, MPFR_RNDN); for(i = 0; i < Qmd; i++){ double elem = logg(t, i); mpfr_set_d(var2, elem, MPFR_RNDN); mpfr_exp(var1, var2, MPFR_RNDN); mpfr_add(summation, summation, var1, MPFR_RNDN); } mpfr_log(summation, summation, MPFR_RNDN); sum2 = mpfr_get_d(summation, MPFR_RNDN); for(i = 0; i < Qmd; i++) logg(t, i) = logg(t, i) - sum2; // finally the gamma_k is computed (called gamma here ) mpfr_set_d(summation, 0.0, MPFR_RNDN); for(j = 0; j < Q; j++){ // for(i = j*MIN_DUR; i < (j+1) * MIN_DUR; i++){ // sum += exp(logg(t, i)); // } gamma(j, t) = exp( logp_k(j, t) + logg(t, j) ); } /* for the EM algorithm we need the sum over xi all over t */ // replicate logalpha(t, :)' matrix along columns mat m1(Qmd, Qmd); for(i = 0; i < Qmd; i++){ for(j = 0; j < Qmd; j++){ m1(i, j) = logalpha(t, i); } } // replicate logbeta matrix vec v1(Qmd); for(i = 0; i < Qmd; i++) v1(i) = logbeta(t+1, i); vec v2(Qmd); for(i = 0; i < Qmd; i++) v2(i) = new_logp(t+1, i); vec v3(Qmd); for(i = 0; i < Qmd; i++) v3(i) = v1(i) + v2(i); // replicate v3 row vector along all rows of matrix m2 mat m2(Qmd, Qmd); for(i = 0; i < Qmd; i++){ for(j = 0; j < Qmd; j++){ m2(i, j) = v3(i); } } // add both matrices m1 and m2 mat m3(Qmd, Qmd); m3 = m1 + m2; // can do direct addition ///mat lognewxi(Qmd, Qmd); // declare lognewxi matrix lognewxi.zeros(); lognewxi = m3 + logA; // add new sum to older sumxi /// first subtract total sum from lognewxi mpfr_set_d(summation, 0.0, MPFR_RNDN); for(i = 0; i < Qmd; i++){ for(j = 0; j < Qmd; j++){ double elem = lognewxi(i, j); mpfr_set_d(var2, elem, MPFR_RNDN); mpfr_exp(var1, var2, MPFR_RNDN); mpfr_add(summation, summation, var1, MPFR_RNDN); //sum += exp(lognewxi(i, j)); } } // now take the logarithm of sum mpfr_log(summation, summation, MPFR_RNDN); sum2 = mpfr_get_d(summation, MPFR_RNDN); // subtract sum from lognewxi for(i = 0; i < Qmd; i++){ for(j = 0; j < Qmd; j++){ lognewxi(i, j) = lognewxi(i, j) - sum2; } } mat newxi(Qmd, Qmd); newxi = lognewxi; // add sumxi and newlogsumxi /// take exponential of each element for(i = 0; i < Qmd; i++){ for(j = 0; j < Qmd; j++){ newxi(i, j) = exp(newxi(i, j)); } } sumxi = sumxi + newxi; } // close the backward induction loop /* handle annoying numerics */ /// calculate sum of lognewxi along each row (lognewxi is already modified in our case) for(i = 0; i < Qmd; i++){ mpfr_set_d(summation, 0.0, MPFR_RNDN); for(j = 0; j < Qmd; j++){ //sum += lognewxi(i, j); double elem = lognewxi(i, j); mpfr_set_d(var2, elem, MPFR_RNDN); mpfr_exp(var1, var2, MPFR_RNDN); mpfr_add(summation, summation, var1, MPFR_RNDN); } sum2 = mpfr_get_d(summation, MPFR_RNDN); gamma1(i) = sum2; } // normalize gamma1 which is prior and normalize sumxi which is transition matrix sum = 0; for(i = 0; i < Qmd; i++) sum += gamma1(i); for(i = 0; i < Qmd; i++) gamma1(i) /= sum; // transition probability matrix will be normalized in train_hmm function /// clear mpfr variables mpfr_clear(summation); mpfr_clear(var1); mpfr_clear(var2); printf("forward-backward algorithm calculation is done...\n"); /* finished forward-backward algorithm */ return ll; }

static void check_inexact (void) { mpfr_t x, y, z, u; mp_prec_t px, py, pu; int inexact, cmp; mp_rnd_t rnd; mpfr_init (x); mpfr_init (y); mpfr_init (z); mpfr_init (u); mpfr_set_prec (x, 28); mpfr_set_prec (y, 28); mpfr_set_prec (z, 1023); mpfr_set_str_binary (x, "0.1000001001101101111100010011E0"); mpfr_set_str (z, "48284762641021308813686974720835219181653367326353400027913400579340343320519877153813133510034402932651132854764198688352364361009429039801248971901380781746767119334993621199563870113045276395603170432175354501451429471578325545278975153148347684600400321033502982713296919861760382863826626093689036010394", 10, GMP_RNDN); mpfr_div (x, x, z, GMP_RNDN); mpfr_set_str_binary (y, "0.1111001011001101001001111100E-1023"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_div for prec=28, RNDN\n"); printf ("Expected "); mpfr_dump (y); printf ("Got "); mpfr_dump (x); exit (1); } mpfr_set_prec (x, 53); mpfr_set_str_binary (x, "0.11101100110010100011011000000100001111011111110010101E0"); mpfr_set_prec (u, 127); mpfr_set_str_binary (u, "0.1000001100110110110101110110101101111000110000001111111110000000011111001010110100110010111111111101000001011011101011101101000E-2"); mpfr_set_prec (y, 95); inexact = test_div (y, x, u, GMP_RNDN); if (inexact != (cmp = get_inexact (y, x, u))) { printf ("Wrong inexact flag (0): expected %d, got %d\n", cmp, inexact); printf ("x="); mpfr_out_str (stdout, 10, 99, x, GMP_RNDN); printf ("\n"); printf ("u="); mpfr_out_str (stdout, 10, 99, u, GMP_RNDN); printf ("\n"); printf ("y="); mpfr_out_str (stdout, 10, 99, y, GMP_RNDN); printf ("\n"); exit (1); } mpfr_set_prec (x, 33); mpfr_set_str_binary (x, "0.101111100011011101010011101100001E0"); mpfr_set_prec (u, 2); mpfr_set_str_binary (u, "0.1E0"); mpfr_set_prec (y, 28); if ((inexact = test_div (y, x, u, GMP_RNDN) >= 0)) { printf ("Wrong inexact flag (1): expected -1, got %d\n", inexact); exit (1); } mpfr_set_prec (x, 129); mpfr_set_str_binary (x, "0.111110101111001100000101011100101100110011011101010001000110110101100101000010000001110110100001101010001010100010001111001101010E-2"); mpfr_set_prec (u, 15); mpfr_set_str_binary (u, "0.101101000001100E-1"); mpfr_set_prec (y, 92); if ((inexact = test_div (y, x, u, GMP_RNDN)) <= 0) { printf ("Wrong inexact flag for rnd=GMP_RNDN(1): expected 1, got %d\n", inexact); mpfr_dump (x); mpfr_dump (u); mpfr_dump (y); exit (1); } for (px=2; px<MAX_PREC; px++) { mpfr_set_prec (x, px); mpfr_random (x); for (pu=2; pu<=MAX_PREC; pu++) { mpfr_set_prec (u, pu); do { mpfr_random (u); } while (mpfr_cmp_ui (u, 0) == 0); { py = MPFR_PREC_MIN + (randlimb () % (MAX_PREC - MPFR_PREC_MIN)); mpfr_set_prec (y, py); mpfr_set_prec (z, py + pu); { rnd = (mp_rnd_t) RND_RAND (); inexact = test_div (y, x, u, rnd); if (mpfr_mul (z, y, u, rnd)) { printf ("z <- y * u should be exact\n"); exit (1); } cmp = mpfr_cmp (z, x); if (((inexact == 0) && (cmp != 0)) || ((inexact > 0) && (cmp <= 0)) || ((inexact < 0) && (cmp >= 0))) { printf ("Wrong inexact flag for rnd=%s\n", mpfr_print_rnd_mode(rnd)); printf ("expected %d, got %d\n", cmp, inexact); printf ("x="); mpfr_print_binary (x); puts (""); printf ("u="); mpfr_print_binary (u); puts (""); printf ("y="); mpfr_print_binary (y); puts (""); printf ("y*u="); mpfr_print_binary (z); puts (""); exit (1); } } } } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (u); }

int main (int argc, char *argv[]) { mpfr_t x, y, z, s; MPFR_SAVE_EXPO_DECL (expo); tests_start_mpfr (); mpfr_init (x); mpfr_init (s); mpfr_init (y); mpfr_init (z); /* check special cases */ mpfr_set_prec (x, 2); mpfr_set_prec (y, 2); mpfr_set_prec (z, 2); mpfr_set_prec (s, 2); mpfr_set_str (x, "-0.75", 10, MPFR_RNDN); mpfr_set_str (y, "0.5", 10, MPFR_RNDN); mpfr_set_str (z, "0.375", 10, MPFR_RNDN); mpfr_fma (s, x, y, z, MPFR_RNDU); /* result is 0 */ if (mpfr_cmp_ui(s, 0)) { printf("Error: -0.75 * 0.5 + 0.375 should be equal to 0 for prec=2\n"); exit(1); } mpfr_set_prec (x, 27); mpfr_set_prec (y, 27); mpfr_set_prec (z, 27); mpfr_set_prec (s, 27); mpfr_set_str_binary (x, "1.11111111111111111111111111e-1"); mpfr_set (y, x, MPFR_RNDN); mpfr_set_str_binary (z, "-1.00011110100011001011001001e-1"); if (mpfr_fma (s, x, y, z, MPFR_RNDN) >= 0) { printf ("Wrong inexact flag for x=y=1-2^(-27)\n"); exit (1); } mpfr_set_nan (x); mpfr_urandomb (y, RANDS); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p (s)) { printf ("evaluation of function in x=NAN does not return NAN"); exit (1); } mpfr_set_nan (y); mpfr_urandomb (x, RANDS); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p(s)) { printf ("evaluation of function in y=NAN does not return NAN"); exit (1); } mpfr_set_nan (z); mpfr_urandomb (y, RANDS); mpfr_urandomb (x, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p (s)) { printf ("evaluation of function in z=NAN does not return NAN"); exit (1); } mpfr_set_inf (x, 1); mpfr_set_inf (y, 1); mpfr_set_inf (z, 1); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0) { printf ("Error for (+inf) * (+inf) + (+inf)\n"); exit (1); } mpfr_set_inf (x, -1); mpfr_set_inf (y, -1); mpfr_set_inf (z, 1); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0) { printf ("Error for (-inf) * (-inf) + (+inf)\n"); exit (1); } mpfr_set_inf (x, 1); mpfr_set_inf (y, -1); mpfr_set_inf (z, -1); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) > 0) { printf ("Error for (+inf) * (-inf) + (-inf)\n"); exit (1); } mpfr_set_inf (x, -1); mpfr_set_inf (y, 1); mpfr_set_inf (z, -1); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) > 0) { printf ("Error for (-inf) * (+inf) + (-inf)\n"); exit (1); } mpfr_set_inf (x, 1); mpfr_set_ui (y, 0, MPFR_RNDN); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p (s)) { printf ("evaluation of function in x=INF y=0 does not return NAN"); exit (1); } mpfr_set_inf (y, 1); mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p (s)) { printf ("evaluation of function in x=0 y=INF does not return NAN"); exit (1); } mpfr_set_inf (x, 1); mpfr_urandomb (y, RANDS); /* always positive */ mpfr_set_inf (z, -1); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p (s)) { printf ("evaluation of function in x=INF y>0 z=-INF does not return NAN"); exit (1); } mpfr_set_inf (y, 1); mpfr_urandomb (x, RANDS); mpfr_set_inf (z, -1); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_nan_p (s)) { printf ("evaluation of function in x>0 y=INF z=-INF does not return NAN"); exit (1); } mpfr_set_inf (x, 1); mpfr_urandomb (y, RANDS); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0) { printf ("evaluation of function in x=INF does not return INF"); exit (1); } mpfr_set_inf (y, 1); mpfr_urandomb (x, RANDS); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0) { printf ("evaluation of function in y=INF does not return INF"); exit (1); } mpfr_set_inf (z, 1); mpfr_urandomb (x, RANDS); mpfr_urandomb (y, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0) { printf ("evaluation of function in z=INF does not return INF"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_urandomb (y, RANDS); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (mpfr_cmp (s, z)) { printf ("evaluation of function in x=0 does not return z\n"); exit (1); } mpfr_set_ui (y, 0, MPFR_RNDN); mpfr_urandomb (x, RANDS); mpfr_urandomb (z, RANDS); mpfr_fma (s, x, y, z, MPFR_RNDN); if (mpfr_cmp (s, z)) { printf ("evaluation of function in y=0 does not return z\n"); exit (1); } { mpfr_prec_t prec; mpfr_t t, slong; mpfr_rnd_t rnd; int inexact, compare; unsigned int n; mpfr_prec_t p0=2, p1=200; unsigned int N=200; mpfr_init (t); mpfr_init (slong); /* generic test */ for (prec = p0; prec <= p1; prec++) { mpfr_set_prec (x, prec); mpfr_set_prec (y, prec); mpfr_set_prec (z, prec); mpfr_set_prec (s, prec); mpfr_set_prec (t, prec); for (n=0; n<N; n++) { mpfr_urandomb (x, RANDS); mpfr_urandomb (y, RANDS); mpfr_urandomb (z, RANDS); if (randlimb () % 2) mpfr_neg (x, x, MPFR_RNDN); if (randlimb () % 2) mpfr_neg (y, y, MPFR_RNDN); if (randlimb () % 2) mpfr_neg (z, z, MPFR_RNDN); rnd = RND_RAND (); mpfr_set_prec (slong, 2 * prec); if (mpfr_mul (slong, x, y, rnd)) { printf ("x*y should be exact\n"); exit (1); } compare = mpfr_add (t, slong, z, rnd); inexact = mpfr_fma (s, x, y, z, rnd); if (mpfr_cmp (s, t)) { printf ("results differ for x="); mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN); printf (" y="); mpfr_out_str (stdout, 2, prec, y, MPFR_RNDN); printf (" z="); mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN); printf (" prec=%u rnd_mode=%s\n", (unsigned int) prec, mpfr_print_rnd_mode (rnd)); printf ("got "); mpfr_out_str (stdout, 2, prec, s, MPFR_RNDN); puts (""); printf ("expected "); mpfr_out_str (stdout, 2, prec, t, MPFR_RNDN); puts (""); printf ("approx "); mpfr_print_binary (slong); puts (""); exit (1); } 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_out_str (stdout, 2, 0, x, MPFR_RNDN); printf (" y="); mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN); printf (" z="); mpfr_out_str (stdout, 2, 0, z, MPFR_RNDN); printf (" s="); mpfr_out_str (stdout, 2, 0, s, MPFR_RNDN); printf ("\n"); exit (1); } } } mpfr_clear (t); mpfr_clear (slong); } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (s); test_exact (); MPFR_SAVE_EXPO_MARK (expo); test_overflow1 (); test_overflow2 (); test_underflow1 (); test_underflow2 (); MPFR_SAVE_EXPO_FREE (expo); tests_end_mpfr (); return 0; }

static void check_for_zero (void) { /* Check that 0 is unsigned! */ mpq_t q; mpz_t z; mpfr_t x; int r; mpfr_sign_t i; mpfr_init (x); mpz_init (z); mpq_init (q); mpz_set_ui (z, 0); mpq_set_ui (q, 0, 1); MPFR_SET_ZERO (x); RND_LOOP (r) { for (i = MPFR_SIGN_NEG ; i <= MPFR_SIGN_POS ; i+=MPFR_SIGN_POS-MPFR_SIGN_NEG) { MPFR_SET_SIGN(x, i); mpfr_add_z (x, x, z, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for add_z & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_sub_z (x, x, z, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for sub_z & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_mul_z (x, x, z, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for mul_z & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_add_q (x, x, q, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for add_q & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_sub_q (x, x, q, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for sub_q & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } } } mpq_clear (q); mpz_clear (z); mpfr_clear (x); }

static void check_special (void) { mpfr_t x, y; int res; char *s; mpfr_init (x); mpfr_init (y); /* Check dummy case */ res = mpfr_strtofr (x, "1234567.89E1", NULL, 10, MPFR_RNDN); mpfr_set_str (y, "1234567.89E1", 10, MPFR_RNDN); if (mpfr_cmp (x, y)) { printf ("Results differ between strtofr and set_str.\n" " set_str gives: "); mpfr_dump (y); printf (" strtofr gives: "); mpfr_dump (x); exit (1); } /* Check NAN */ mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "NaN", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || *s != 0) { printf ("Error for setting NAN (1)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "+NaN", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || *s != 0) { printf ("Error for setting +NAN (1)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, " -NaN", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || *s != 0) { printf ("Error for setting -NAN (1)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "@[email protected]", &s, 16, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "xx") ) { printf ("Error for setting NAN (2)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "NAN(abcdEDF__1256)Hello", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "Hello") ) { printf ("Error for setting NAN (3)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "NAN(abcdEDF)__1256)Hello", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "__1256)Hello") ) { printf ("Error for setting NAN (4)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "NAN(abc%dEDF)__1256)Hello", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "(abc%dEDF)__1256)Hello") ) { printf ("Error for setting NAN (5)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "NAN((abc))", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "((abc))") ) { printf ("Error for setting NAN (6)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */ res = mpfr_strtofr (x, "NAN()foo", &s, 10, MPFR_RNDN); if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "foo") ) { printf ("Error for setting NAN (7)\n"); exit (1); } /* Check INF */ res = mpfr_strtofr (x, "INFINITY", &s, 8, MPFR_RNDN); if (res != 0 || !mpfr_inf_p (x) || *s != 0) { printf ("Error for setting INFINITY (1)\n s=%s\n x=", s); mpfr_dump (x); exit (1); } res = mpfr_strtofr (x, "INFANITY", &s, 8, MPFR_RNDN); if (res != 0 || !mpfr_inf_p (x) || strcmp(s, "ANITY")) { printf ("Error for setting INFINITY (2)\n s=%s\n x=", s); mpfr_dump (x); exit (1); } res = mpfr_strtofr (x, "@[email protected]*2", &s, 11, MPFR_RNDN); if (res != 0 || !mpfr_inf_p (x) || strcmp(s, "*2")) { printf ("Error for setting INFINITY (3)\n s=%s\n x=", s); mpfr_dump (x); exit (1); } /* Check Zero */ res = mpfr_strtofr (x, " 00000", &s, 11, MPFR_RNDN); if (res != 0 || !mpfr_zero_p (x) || s[0] != 0) { printf ("Error for setting ZERO (1)\n s=%s\n x=", s); mpfr_dump (x); exit (1); } /* Check base 62 */ res = mpfr_strtofr (x, "A", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 10)) { printf ("Error for setting 'A' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "a", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 36)) { printf ("Error for setting 'a' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "Z", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 35)) { printf ("Error for setting 'Z' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "z", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 61)) { printf ("Error for setting 'z' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "ZA", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 2180)) { printf ("Error for setting 'ZA' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "za", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 3818)) { printf ("Error for setting 'za' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "aZ", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 2267)) { printf ("Error for setting 'aZ' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "Az", NULL, 62, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 681)) { printf ("Error for setting 'Az' in base 62\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check base 60 */ res = mpfr_strtofr (x, "Aa", NULL, 60, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 636)) { printf ("Error for setting 'Aa' in base 60\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } res = mpfr_strtofr (x, "Zz", &s, 60, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 35) || strcmp(s, "z") ) { printf ("Error for setting 'Zz' in base 60\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } /* Check base 61 */ res = mpfr_strtofr (x, "z", &s, 61, MPFR_RNDN); if (res != 0 || mpfr_cmp_ui (x, 0) || strcmp(s, "z") ) { printf ("Error for setting 'z' in base 61\n x="); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n'); exit (1); } mpfr_clear (x); mpfr_clear (y); }

static void special (void) { mpfr_t x, y; int i; mpfr_init (x); mpfr_init (y); mpfr_set_nan (x); test_expm1 (y, x, MPFR_RNDN); if (!mpfr_nan_p (y)) { printf ("Error for expm1(NaN)\n"); exit (1); } mpfr_set_inf (x, 1); test_expm1 (y, x, MPFR_RNDN); if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0) { printf ("Error for expm1(+Inf)\n"); exit (1); } mpfr_set_inf (x, -1); test_expm1 (y, x, MPFR_RNDN); if (mpfr_cmp_si (y, -1)) { printf ("Error for expm1(-Inf)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); test_expm1 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0) { printf ("Error for expm1(+0)\n"); exit (1); } mpfr_neg (x, x, MPFR_RNDN); test_expm1 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0) { printf ("Error for expm1(-0)\n"); exit (1); } /* Check overflow of expm1(x) */ mpfr_clear_flags (); mpfr_set_str_binary (x, "1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDN); MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0); MPFR_ASSERTN (mpfr_overflow_p ()); MPFR_ASSERTN (i == 1); mpfr_clear_flags (); mpfr_set_str_binary (x, "1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDU); MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0); MPFR_ASSERTN (mpfr_overflow_p ()); MPFR_ASSERTN (i == 1); mpfr_clear_flags (); mpfr_set_str_binary (x, "1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDD); MPFR_ASSERTN (!MPFR_IS_INF (x) && MPFR_SIGN (x) > 0); MPFR_ASSERTN (mpfr_overflow_p ()); MPFR_ASSERTN (i == -1); /* Check internal underflow of expm1 (x) */ mpfr_set_prec (x, 2); mpfr_clear_flags (); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDN); MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == -1); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDD); MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == -1); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDZ); MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == 1); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDU); MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == 1); mpfr_clear (x); mpfr_clear (y); }