APLVFP PrimFnMonQuoteDotVisV (APLVFP aplVfpRht, LPPRIMSPEC lpPrimSpec) { APLMPI mpzRes = {0}; APLVFP mpfRes = {0}; // Check for indeterminates: !N for integer N < 0 if (mpfr_integer_p (&aplVfpRht) && mpfr_cmp_ui (&aplVfpRht, 0) < 0) return *mpfr_QuadICValue (&aplVfpRht, // No left arg ICNDX_QDOTn, &aplVfpRht, &mpfRes, FALSE); // Check for PosInfinity if (IsMpfPosInfinity (&aplVfpRht)) return mpfPosInfinity; // If the arg is an integer, // and it fits in a ULONG, ... if (mpfr_integer_p (&aplVfpRht) && mpfr_fits_uint_p (&aplVfpRht, MPFR_RNDN)) { mpz_init (&mpzRes); mpfr_init0 (&mpfRes); mpz_fac_ui (&mpzRes, mpfr_get_ui (&aplVfpRht, MPFR_RNDN)); mpfr_set_z (&mpfRes, &mpzRes, MPFR_RNDN); Myz_clear (&mpzRes); } else { // Initialize the result mpfr_init_set (&mpfRes, &aplVfpRht, MPFR_RNDN); mpfr_add_ui (&mpfRes, &mpfRes, 1, MPFR_RNDN); // Let MPFR handle it mpfr_gamma (&mpfRes, &mpfRes, MPFR_RNDN); #ifdef DEBUG mpfr_free_cache (); #endif } // End IF/ELSE return mpfRes; } // End PrimFnMonQuoteDotVisV
int main (void) { mpfr_t x; tests_start_mpfr (); mpfr_init2 (x, 256); /* Check NAN */ mpfr_set_nan(x); if (mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_slong_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_uint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_sint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR1; /* Check INF */ mpfr_set_inf(x, 1); if (mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_slong_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_uint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_sint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR1; /* Check Zero */ MPFR_SET_ZERO(x); if (!mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_slong_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_uint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR2; /* Check small op */ mpfr_set_str1 (x, "1@-1"); if (!mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_slong_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_uint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR2; /* Check 17 */ mpfr_set_ui (x, 17, GMP_RNDN); if (!mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_slong_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_uint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR2; /* Check all other values */ mpfr_set_ui(x, ULONG_MAX, GMP_RNDN); mpfr_mul_2exp(x, x, 1, GMP_RNDN); if (mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_slong_p(x, GMP_RNDN)) ERROR1; mpfr_mul_2exp(x, x, 40, GMP_RNDN); if (mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_uint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_sint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR1; mpfr_set_ui(x, ULONG_MAX, GMP_RNDN); if (!mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR2; mpfr_set_ui(x, LONG_MAX, GMP_RNDN); if (!mpfr_fits_slong_p(x, GMP_RNDN)) ERROR2; mpfr_set_ui(x, UINT_MAX, GMP_RNDN); if (!mpfr_fits_uint_p(x, GMP_RNDN)) ERROR2; mpfr_set_ui(x, INT_MAX, GMP_RNDN); if (!mpfr_fits_sint_p(x, GMP_RNDN)) ERROR2; mpfr_set_ui(x, USHRT_MAX, GMP_RNDN); if (!mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR2; mpfr_set_ui(x, SHRT_MAX, GMP_RNDN); if (!mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR2; mpfr_set_si(x, 1, GMP_RNDN); if (!mpfr_fits_sint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR2; /* Check negative value */ mpfr_set_si (x, -1, GMP_RNDN); if (!mpfr_fits_sint_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_sshort_p(x, GMP_RNDN)) ERROR2; if (!mpfr_fits_slong_p(x, GMP_RNDN)) ERROR2; if (mpfr_fits_uint_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_ushort_p(x, GMP_RNDN)) ERROR1; if (mpfr_fits_ulong_p(x, GMP_RNDN)) ERROR1; mpfr_clear (x); check_intmax (); tests_end_mpfr (); return 0; }
int main (void) { mpfr_t x, y; int i, r; tests_start_mpfr (); mpfr_init2 (x, 256); mpfr_init2 (y, 8); RND_LOOP (r) { /* Check NAN */ mpfr_set_nan (x); if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (1); if (mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (2); if (mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (3); if (mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (4); if (mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (5); if (mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (6); /* Check INF */ mpfr_set_inf (x, 1); if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (7); if (mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (8); if (mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (9); if (mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (10); if (mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (11); if (mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (12); /* Check Zero */ MPFR_SET_ZERO (x); if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (13); if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (14); if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (15); if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (16); if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (17); if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (18); /* Check small positive op */ mpfr_set_str1 (x, "1@-1"); if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (19); if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (20); if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (21); if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (22); if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (23); if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (24); /* Check 17 */ mpfr_set_ui (x, 17, MPFR_RNDN); if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (25); if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (26); if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (27); if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (28); if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (29); if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (30); /* Check all other values */ mpfr_set_ui (x, ULONG_MAX, MPFR_RNDN); mpfr_mul_2exp (x, x, 1, MPFR_RNDN); if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (31); if (mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (32); mpfr_mul_2exp (x, x, 40, MPFR_RNDN); if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (33); if (mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (34); if (mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (35); if (mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (36); if (mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (37); mpfr_set_ui (x, ULONG_MAX, MPFR_RNDN); if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r)) ERROR1 (38); mpfr_set_ui (x, LONG_MAX, MPFR_RNDN); if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (39); mpfr_set_ui (x, UINT_MAX, MPFR_RNDN); if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r)) ERROR1 (40); mpfr_set_ui (x, INT_MAX, MPFR_RNDN); if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (41); mpfr_set_ui (x, USHRT_MAX, MPFR_RNDN); if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r)) ERROR1 (42); mpfr_set_ui (x, SHRT_MAX, MPFR_RNDN); if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (43); mpfr_set_si (x, 1, MPFR_RNDN); if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (44); if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (45); /* Check negative op */ for (i = 1; i <= 4; i++) { int inv; mpfr_set_si_2exp (x, -i, -2, MPFR_RNDN); mpfr_rint (y, x, (mpfr_rnd_t) r); inv = MPFR_NOTZERO (y); if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r) ^ inv) ERROR1 (46); if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r)) ERROR1 (47); if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r) ^ inv) ERROR1 (48); if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r)) ERROR1 (49); if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r) ^ inv) ERROR1 (50); if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r)) ERROR1 (51); } } mpfr_clear (x); mpfr_clear (y); check_intmax (); tests_end_mpfr (); return 0; }