Math-MPFR-3.32/0000755000076400010400000000000012660557761014563 5ustar sisyphusAdministratorsMath-MPFR-3.32/CHANGES0000644000076400010400000004066512660557734015571 0ustar sisyphusAdministrators3.32 - Corrections to fixes to t/DoubleDouble2.t and t/bytes.t. (Same problem existed with some addtional architectures, too.) Version 3.31 will be marked for removal to backpan. 3.31 - Fixes to t/DoubleDouble2.t and t/bytes.t (which were failing on machines that had the "double-double" type, but only when perl's nvtype was double). 3.30 - Correction to the negative zero bug workaround in Rmpfr_fits_uintmax_p (which had previously been returning false for (-0, MPFR_RNDD). - Remove Rmpfr_set_str_binary and Rmpfr_print_binary. (Obsolete in mpfr library.) - Fix t/LongDouble.t for change to Math::LongDouble output precision (ticket #111813) 3.29 - Add _d_bytes XSub. - Simplify demos/doubledouble.p - Allow _d_bytes, _ld_bytes, and _f128_bytes to determine the base of the given argument. - Add _d_bytes_fr, _dd_bytes_fr, _ld_bytes_fr and _f128_bytes_fr - Add bytes() function. - Amend typedef of __float128 alignment (Windows only) - Add Rmpfr_get_q (even though MPFR does not implement mpfr_get_q) - define mp_bitcnt_t to unsigned long int for pre-gmp-5.0.0 3.28 - Fix mistake in test 5 in t/bytes.t. 3.27 - Replace mpfr_set_default_prec() calls in _ld_bytes and _f128_bytes with appropriate mpfr_init2() calls. 3.26 - Re-phrase misleading message in t/use64bitint.t. (Message implied that absence of 'long long int' implied that ivsize was 32-bit.) - Add Rmpfr_print_rnd_mode - previously missed. - Rewrite rounding value check as CHECK_ROUNDING_VALUE macro - Add _ld_bytes and _f128_bytes XSub (for use of Math::NV) 3.25 - Catch the error of giving too large a "size" argument to mpfr_sum.t and add a check for this to t/sum.t - Amend the #definition of LNGAMMA_BUG to cater for the fact that mpfr-3.1.3 did *not* contain a fix for the lngamma bug. 3.24 - Rename the Rgmp_randstate* functions to Rmpfr_randstate*, and move them into their own (Math::MPFR::Random) module. - Standardise numeric treatment of strings that contain non-numeric characters. Add Math::MPFR::NNW and Math::MPFR::nnumflag() & friends. - Correction to t/native_float128.t - Use NVtoD64 to assign NV to Math::Decimal64 object in D64_LD.t - as Math::Decimal64::new() is no longer capable of making that assignment. 3.23 - Rename Rmpfr_get_decimal64, Rmpfr_set_decimal64, Rmpfr_get_float128 & Rmpfr_set_float128 to Rmpfr_get_DECIMAL64, Rmpfr_set_DECIMAL64, Rmpfr_get_FLOAT128 & Rmpfr_set_FLOAT128 - Provide Rmpfr_get_float128 & Rmpfr_set_float128 which pass the __float128 value as an NV - Ensure that when casting an IV/NV to an mpfr_t, the mpfr_t has enough precision to accurately represent the value. - No longer define USE_64_BIT_INT if ivtype is 'long'. (Thus had to tweak some test files.) - Rename USE_64_BIT_INT #define to MATH_MPFR_NEED_LONG_LONG_INT - Define IVSIZE_BITS (in XS file) if MATH_MPFR_NEED_LONG_LONG_INT is defined - for use in initialization of mpfr_t in some of the overload functions. - Add FLOAT128_DIG 3.22 - Add some metadata to Makefile.PL. - Fix the LNGAMMA_BUG workaround in mpfr.c, and change test 69 in t/test1.t to test for correct behaviour of mpfr_lngamma(). - Add Rmpfr_set_NV - and use it in new(). - Remove Rmpfr_sprintf_ret and Rmpfr_snprintf_ret. - No longer include inttypes.h on the basis of USE_LONG_DOUBLE being defined. (Was harmless ... but didn't make much sense.) - Define PERL_NO_GET_CONTEXT. - Tweaks to Math::MPFR::gmp_v() and Math::MPFR::V::gmp_v() 3.21 - Fix errors in t/decimal64_conv.t 3.19 - Rewrite _wrap_mpfr_sprintf(), _wrap_mpfr_snprintf(), _wrap_mpfr_sprintf_rnd() and _wrap_mpfr_snprintf_rnd(). Their first arg has been changed from a char* to an SV*, and they take an additional argument that specifies the size of the buffer (1st arg) into which the resultant string is written. - Change Rmpfr_sprintf_ret() and Rmpfr_snprintf_ret(). The first arg (buffer) has been removed, and an additional argument that specifies the size of the buffer into which the resultant string is written needs to be provided. - Fix spelling error in doc. Thanks Salvatore Bonaccorso. (Ticket #89710) - Add Rmpfr_set_float128 and Rmpfr_get_float128. These provide access to the '__float128' data type (for compilers that support the type) via the Math::Float128 module. - Simplify querying of Decimal64 support in the mpfr library being used - Add MPFR_DBL_DIG, MPFR_LDBL_DIG, mpfr_max_orig_len, mpfr_min_inter_prec, mpfr_min_inter_base and mpfr_max_orig_base. - Have lngamma(-0) be +Inf instead of NaN. (Bug in mpfr 3.1.2 and earlier.) 3.18 - Depending upon the rounding mode values, the mpfr library may incorrectly return false for mpfr_fits_u*_p(x) for -1.0 < x < 0.0 or for -0.5 < x <0.0. (This should be fixed in versions of mpfr later than 3.1.2.) Have the Rmpfr_fits_u*_p() functions return correct result irrespective of the version of mpfr being used - and have the Math:MPFR test suite test for this. - The 'P' type specifier (precision) wasn't working correctly on big-endian machines when mp_prec_t size is less than IV size. Add a prec_cast function to fix this. - Add an _mp_sizes function (not exportable) that returns the sizes of mpfr_exp_t, mpfr_prec_t and mpfr_rnd_t. - Add Math::MPFR::_ivsize (not exportable). - Add Math::MPFR::_nvsize (not exportable). - Correct the Rmpfr_*printf functions so that they croak with an appropriate error message if a rounding arg is supplied but the last arg is not a Math::MPFR object. 3.17 - Apply patch to MPFR.xs from Daniel Kahn Gillmor that eliminates "null argument where non-null required" warnings. - Fix typo in croak() message in MPFR.xs (also caught by Daniel). 3.16 - Add Rmpfr_set_LD() and Rmpfr_get_LD(). These provide access to the 'long double' data type (for perls whose nvtype is double) via the Math::LongDouble module. 3.15 - Add _Decimal64-mpfr_t conversion 3.14 - Fix pod. (The '±' symbol was causing pod.t failures.) Also took care of some other typos/oversights in the documentation. 3.13 - Add Math::MPFR::V - Add pre/post increment/decrement operations (overload_add and overload_inc) - Allow (cross-class) overloading of basic math operations with Math::GMPz, Math::GMPq and Math::GMPf objects. 3.12 - Remove 'not' from overloads. Apparently achieved nothing anyway, and 5.16 warns that it's invalid. 3.11 - Add t/tls.t and t/tls_flags.t (to test the thread local storage capabilities, where applicable). 3.10 - Add the following functions (conditional upon building against mpfr-3.1.0 or later): Rmpfr_set_divby0, Rmpfr_clear_divby0, Rmpfr_divby0_p, Rmpfr_buildopt_tune_case, Rmpfr_frexp, Rmpfr_grandom, Rmpfr_z_sub, Rmpfr_buildopt_gmpinternals_p. - Add Rgmp_randinit_mt. - In Rmpfr_get_d_2exp and Rmpfr_get_ld_2exp, replace sv_setuv (was incorrect) with sv_setiv. - Replace New/Newz with Newx/Newxz on perls that support the new symbols (Newx/Newxz). 3.02 - Rmpfr_min_prec now available only when building against mpfr-3.0.0 or later. (The mpfr_min_prec function was not available until 3.0.0.) 3.01 - Remove the (outdated) link to http://www.loria.fr/projets/mpfr/mpfr-current/mpfr.html in the "DESCRIPTION" section of the documentation. (Thanks Hugh Myers.) - In the documentation, elaborate on the way that Rmpfr_get-version() and MPFR_VERSION & friends determine their values. (Thanks Vincent Lefevre.) - Correct Rmpfr_min_prec(), and remove Rmpfr_max_prec(). 3.0 - Corresponding to release of mpfr-3.0.0. (Still needs only 2.4.0, but 3.0.0 needed to take advantage of all features.) - Add MPFR_* rounding modes (including MPFR_RNDA for builds against mpfr-3.0.0) - Add Rmpfr_buildopt_tls_p() and Rmpfr_buildopt_decimal_p() (mpfr-3.0.0 only) - Add the following functions, specific to mpfr-3.0.0: Rmpfr_regular_p, Rmpfr_set_zero, Rmpfr_digamma, Rmpfr_ai, Rmpfr_set_flt, Rmpfr_get_flt, Rmpfr_urandom and Rmpfr_set_z_2exp. - Add Rmpfr_get_z_2exp (mpfr_get_z_exp is now renamed to mpfr_get_z_2exp). - Add gmp_randstate_t* to the Math::MPFR typemap. - Change handling of NaNs (wrt overloaded comparison operators). The overloaded spaceship operator now returns undef when NaNs are involved (more in keeping with perl behaviour), and the erange flag is now set whenever a comparison involving NaNs is performed (more in keeping with the mpfr library behaviour). This is irrespective of whether the NaN is a Math::MPFR object or a perl NV. The other comparison operators now also set the erange flag when a NaN is involved (for compatibility with the mpfr library). - Add Rmpfr_snprintf and Rmpfr_snprintf_ret. - Add Rmpfr_inits, Rmpfr_inits2 and Rmpfr_clears functions. - The overload_copy sub now preserves the precision of the copied object (instead of taking on default precision). 2.03 - Needs version 2.4.0 (or later) of the mpfr library. - Add the following functions (new in mpfr-2.4.0): Rmpfr_add_d, Rmpfr_sub_d, Rmpfr_d_sub Rmpfr_mul_d, Rmpfr_div_d, Rmpfr_d_div, Rmpfr_rec_sqrt, Rmpfr_sinh_cosh, Rmpfr_li2, Rmpfr_zeta_ui, Rmpfr_modf, Rmpfr_fmod, Rmpfr_printf, Rmpfr_fprintf, Rmpfr_sprintf, Rmpfr_sprintf_ret - Fix overload_sqrt() so that it returns a NaN for negative operands instead of croaking, as was originally the case. - Remove (the need for) INLINE.h - Add RMPFR_PREC_MIN and RMPFR_PREC_MAX. - Add Rmpfr_sum, Rmpfr_get_d_2exp, Rmpfr_get_ld_2exp, Rmpfr_dim, Rmpfr_fits_ushort_p, Rmpfr_fits_sshort_p, Rmpfr_fits_uint_p, Rmpfr_fits_sint_p, Rmpfr_fits_uintmax_p, Rmpfr_fits_intmax_p, Rmpfr_fits_IV_p, Rmpfr_fits_UV_p Rmpfr_add_si Rmpfr_get_UV Rmpfr_get_IV Rmpfr_get_NV 2.02 - Add TRmpfr_out_str/TRmpfr_inp_str (which wraps mpfr_out_str/mpfr_inp_str more Truly than Rmpfr_out_str/Rmpfr_inp_str). - Rmpfr_out_str now has the option to take a prefix string. - Remove the tests in the Makefile.PL that test for the presence of a suitable compiler, GMP library and MPFR library. 2.01 - Needs version 2.3.0 (or later) of the mpfr library. - Add Rmpfr_j0, Rmpfr_j1, Rmpfr_jn, Rmpfr_y0, Rmpfr_y1, Rmpfr_yn, Rmpfr_lgamma, Rmpfr_remainder, Rmpfr_remquo, Rmpfr_fms, Rmpfr_signbit, Rmpfr_setsign, and Rmpfr_copysign(all new in 2.3.0). Add also Rmpfr_get_patches (documented for the first time in 2.3.0). - Add Rmpfr_init_set_ld. - Add Rmpfr_deref2 to the list of exportable functions, and document it's usage in the POD section. - Rmpfr_deref2 now has the mpfr library allocate (and free) memory for the mantissa. - Add Rmpfr_hypot (previously missed). - Rmpfr_out_str now takes an optional fifth argument (a string that will be appended to the mpfr_out_str output). And the output buffer is now flushed each time Rmpfr_out_str is called. - Rewrite new() - to make it a little tidier. - Add Rmpfr_set_uj and Rmpfr_set_uj_2exp to @EXPORT_TAGS. (Previously overlooked.) - Add Rmpfr_integer_string() - mainly to provide a simple means of getting 'sj' and 'uj' values on a 64-bit perl where the MPFR library does not support mpfr_get_uj and mpfr_get_sj functions - which happens with libraries built with Microsoft Compilers. - Fix the rendering of Inf and NaN values. (Now matches the mpfr_out_str output for Inf and NaN.) - Change the format returned by Rmpfr_get_str. (Hence the output of Rmpfr_get_string and Math::MPFR::overload_string have changed from earlier versions of Math::MPFR.) - Fix some of the overloaded subroutines as regards their handling of NaN. 1.11 - Fix bug in Rmpfr_get_str. (Sometimes printed out one less digit than it ought.) - Remove mpfr.info from distribution. Refer instead to: http://www.mpfr.org/mpfr-current/mpfr.html - Have 'make clean' remove comp.exe, check.exe and version.exe. - Add support for perls built with -Duselongdouble (Rmpfr_*_ld functions, except Rmpfr_init_set_ld() which is not available in unpatched 2.2.1). - Add Rmpfr_cmp_d, Rmpfr_exp10 and the Rmpfr_*_uj functions (which had somehow been earlier overlooked). - Fix handling of unsigned long longs on perls built with -Duse64bitint. - Allow assignment of mpz, mpq, and mpf types using new() 1.10 - No longer assign Exporter and DynaLoader to @Math::MPFR::ISA. - Add support for perls built with -Duse64bitint. This involved the inclusion of the Rmpfr_set_sj, Rmpfr_set_sj_2exp and Rmpfr_get_sj functions - as well as some alterations to the overload subs. 1.09 - Changes to the format returned by Rmpfr_get_str and overload_string. - Add a new() method/function for creation of mpfr_t objects. - Fix Rmpfr_out_str() and Rmpfr_inp_str() - were segfaulting with MS compilers. 1.08 - As of this version, MPFR-2.2.x is required. - Add new functions made available with the release of MPFR-2.2.0: Rmpfr_set_overflow Rmpfr_set_underflow Rmpfr_set_inexflag Rmpfr_set_erangeflag Rmpfr_set_nanflag Rmpfr_erfc Rmpfr_atan2 Rmpfr_pow_z Rmpfr_subnormalize Rmpfr_const_catalan Rmpfr_sec Rmpfr_csc Rmpfr_cot Rmpfr_root Rmpfr_eint Rmpfr_get_f Rmpfr_sech Rmpfr_csch Rmpfr_coth Rmpfr_lngamma RMPFR_VERSION_NUM - Add constants (actually implemented as subroutines): MPFR_VERSION MPFR_VERSION_MAJOR MPFR_VERSION_MINOR MPFR_VERSION_PATCHLEVEL MPFR_VERSION_STRING - Remove Rmpfr_add_one_ulp and Rmpfr_sub_one_ulp (no longer supported by the MPFR library). - Redefine '__gmpfr_default_rounding_mode' in MPFR.xs as it's no longer in mpfr.h. (Been moved to mpfr-impl.h which I don't want to include.) - Rewrite of overload_atan2 - now that mpfr_atan2 is available in MPFR-2.2.0. (Also fixes a bug in overload_atan2). 1.07 - New() was allocating more memory than necessary in many instances. Rewrote the XS code (in those instances) to fix that. - Add Rmpfr_strtofr 1.06 - Modify the Makefile.PL checks added in version 1.05 to cater for those building with a Microsoft compiler - Alter Rmpfr_set_str and Rmpfr_init_set_str so that a base of 0 can be specified - in which case the base is determined from the input string - Added the following functions: Rmpfr_get_ui Rmpfr_get_si Rmpfr_fits_ulong_p Rmpfr_fits_slong_p - Fix a bug in 'Rmpfr_deref2()' - used by 'overload_print()' - Provide more complete testing with 4 new test files - namely test4.t, trig.t, set_str.t and exceptions.t. 1.05 - Add some checks to Makefile.PL to ensure that anyone trying to build this module has an up-to-date MPFR library. This is mainly an attempt to stop cpan testers who don't have an up-to-date MPFR from testing the module and subsequently reporting "FAIL" or "NA". 1.04 - Math::MPFR-1.04 to 1.07 require MPFR-2.1.x. - Added the following functions, not available with versions earlier than 2.1.0 : Rmpfr_set_ui_2exp Rmpfr_set_si_2exp Rmpfr_get_z Rmpfr_si_sub Rmpfr_sub_si Rmpfr_mul_si Rmpfr_si_div Rmpfr_div_si Rmpfr_sqr Rmpfr_cmp_z Rmpfr_cmp_q Rmpfr_cmp_f Rmpfr_zero_p Rmpfr_free_cache Rmpfr_get_version Rmpfr_get_emin_min Rmpfr_get_emin_max Rmpfr_get_emax_min Rmpfr_get_emax_max Rmpfr_clear_erangeflag Rmpfr_erangeflag_p Rmpfr_rint_round Rmpfr_rint_trunc Rmpfr_rint_ceil Rmpfr_rint_floor 1.03 - Replace 'SvROK()' with 'sv_isobject()' in the overload functions. - Make 'get_refcnt()' and 'get_package_name()' non-exportable. 1.02 - Make overloading work with strings. - Add 'Rmpfr_dump'. - Add 'Math::MPFR::gmp_v' (not exportable). 1.01 - Eradicate segfault that was occurring when 'overload_add', 'overload_sub', 'overload_mul', 'overload_div' and 'overload_pow' croaked due to invalid argument(s). 0.07 - Replace 'Rmpfr_round_prec' with 'Rmpfr_prec_round' in keeping with changes to the MPFR library. - Remove 'Rmpfr_random' (deprecated). - Add 'Rmpfr_cbrt', 'Rmpfr_cmpabs', ', 'Rmpfr_greater_p', 'Rmpfr_greaterequal_p', 'Rmpfr_less_p', 'Rmpfr_lessequal_p', 'Rmpfr_lessgreater_p', 'Rmpfr_equal_p', 'Rmpfr_unordered_p', 'Rmpfr_inp_str', 'Rmpfr_frac', 'Rmpfr_integer_p', 'Rmpfr_nexttoward', 'Rmpfr_nextabove', 'Rmpfr_next_below', 'Rmpfr_min', 'Rmpfr_max', 'Rmpfr_get_exp', 'Rmpfr_set_exp' 'Rgmp_randinit_default', 'Rgmp_randinit_lc_2exp', 'Rgmp_randinit_lc_2exp_size', 'Rgmp_randseed', 'Rgmp_randseed_ui', 'Rgmp_randclear'. - Change module name from 'Math::GnuMPfr' to 'Math::MPFR'. 0.06 - Add 'Rmpfr_gamma()', 'Rmpfr_zeta()', and 'Rmpfr_erf()'. - Add overloading for 'atan2', 'cos', 'sin', 'log', 'exp', and 'int'. 0.05 - Requires mpfr-2.0.3 - Add 'Rmpfr_out_str()' - Add 'Rmpfr_get_default_rounding_mode()' - Rename 'Rmpfr_set_str_raw()' to 'Rmpfr_set_str_binary()' in keeping with changes to the MPFR library. - Alter 'Rmpfr_check_range()' in keeping with change to 'mpfr_check_range()' in the MPFR library. - Introduce operator overloading. Math-MPFR-3.32/demos/0000755000076400010400000000000012660557757015677 5ustar sisyphusAdministratorsMath-MPFR-3.32/demos/doubledouble.p0000644000076400010400000000631612660557734020526 0ustar sisyphusAdministrators# Provide floating point values on the command line (@ARGV) and see those # values represented in doubledouble big endian format. # The subs dd_str() and dd_obj() return both doubles ($msd, $lsd) - where $msd is the most # significant double and $lsd the least significant double. The actual value represented by # the double is the sum of the two doubles. # As an example, try: # perl doubledouble.p 2.3 1e+127 0x17.fe99991f9999999999999888888888888888888 use warnings; use strict; use Math::MPFR qw(:mpfr); die "Must provide at least one command line argument" if !@ARGV; for my $float(@ARGV) { my($msd, $lsd) = dd_str($float); print "$float\n"; printf "%.14e %.14e\n", $msd, $lsd; print internal_hex($msd) . " "; print internal_hex($lsd) . "\n"; my $test = Rmpfr_init2(2098); Rmpfr_set_str($test, $float, 0, MPFR_RNDN); my @check = dd_obj($test); if($check[0] == $msd && $check[1] == $lsd) { print "dd_obj() checks out correctly\n"; } else {print "dd_obj() failed\n"} @check = dd2dd($msd, $lsd); if($check[0] == $msd && $check[1] == $lsd) { print "dd2dd() checks out correctly\n\n"; } else {print "dd2dd() failed\n\n"} } ################################################ ################################################ sub dd_str { my $val = Rmpfr_init2(2098); # Max precision that can be encapsulated in doubledouble Rmpfr_set_str($val, $_[0], 0, MPFR_RNDN); my $msd = Rmpfr_get_d($val, MPFR_RNDN); $val -= $msd; return ($msd, Rmpfr_get_d($val, MPFR_RNDN)); } # sub dd_obj takes a Math::MPFR object (with 2098-bit precision) as its arg sub dd_obj { my $obj = shift; die "arg to dd_obj() is not a Math::MPFR object" if Math::MPFR::_itsa($obj) != 5; my $prec = Rmpfr_get_prec($obj); die "arg to dd_obj() has $prec bits of precision - but needs to have 2098 bits" if $prec != 2098; my $msd = Rmpfr_get_d($obj, MPFR_RNDN); $obj -= $msd; return ($msd, Rmpfr_get_d($obj, MPFR_RNDN)); } # sub dd2dd takes 2 doubles as arguments. It returns the 2 doubles (msd, lsd) that form the # double-double representation of the sum of the 2 arguments. We can therefore use this function # to question whether the 2 arguments are a valid double-double pair - the answer being "yes" if # and only if dd2dd() returns the identical 2 values that it received as arguments. # In the process, it prints out the internal hex representations of both arguments, and the # internal hex representations of the 2 doubles that it returns. sub dd2dd { my $val = Rmpfr_init2(2098); Rmpfr_set_ui($val, 0, MPFR_RNDN); print " HEX_INPUT : ", internal_hex($_[0]), " ", internal_hex($_[1]), "\n"; Rmpfr_add_d($val, $val, $_[0], MPFR_RNDN); Rmpfr_add_d($val, $val, $_[1], MPFR_RNDN); my @ret = dd_obj($val); print " HEX_OUTPUT: ", internal_hex($ret[0]), " ", internal_hex($ret[1]), "\n"; return @ret; } # sub internal_hex returns the internal hex format (byte structure) of the double precision # argument it received. sub internal_hex { return scalar(reverse(unpack("h*", (pack "d<", $_[0])))); } # sub internal_hex2dec does the reverse of internal_hex() - ie returns the value, derived from # the internal hex argument. sub internal_hex2dec { return unpack "d<", pack "h*", scalar reverse $_[0]; } __END__ Math-MPFR-3.32/Makefile.PL0000644000076400010400000001056712660557734016546 0ustar sisyphusAdministratorsuse ExtUtils::MakeMaker; use Config; #require 5.008008; our %args = map { split /\s*=\s*/ } @ARGV; our $LIBS = $args{ LIBS } || "-lmpfr -lgmp"; our $INC = $args{ INC }; $use_64_bit_int = 0; # Let perl decide whether to include 64-bit 'long long' support $use_long_double = 0;# Let perl decide whether to include 'long double' support #$use_64_bit_int = -1; # Force exclusion of 64-bit 'long long' support #$use_long_double = -1;# Force exclusion of 'long double' support #$use_64_bit_int = 1; # Force inclusion of 64-bit 'long long' support #$use_long_double = 1;# Force inclusion of 'long double' support $have_decimal64 = 0; for(@ARGV) { $have_decimal64 = 1 if $_ eq 'D64=1'; } #$have_decimal64 = 1; # Force inclusion of _Decimal64 support # This will also define MPFR_WANT_DECIMAL_FLOATS (as that needs to be defined # before mpfr.h is included). my $d64_message = $have_decimal64 ? "Attempting to build with _Decimal64 support\n" : "Building without _Decimal64 support\n"; # We want to set $have_float128 to 1 if and only if: # the mpfr library was built with the configure option '--enable-float128' && either: # $Config{nvtype} is '__float128' # or # Math::Float128 has been installed. $have_float128 = 0; for(@ARGV) { $have_float128 = 1 if $_ eq 'F128=1'; } #$have_float128 = 1; # Force inclusion of __float128 support # This will also define MPFR_WANT_FLOAT128 (as that needs to be defined # before mpfr.h is included). my $float128_message = $have_float128 ? "Attempting to build with __float128 support\n" : "Building without __float128 support\n"; my $defines = $] < 5.008 ? "-DOLDPERL" : "-DNEWPERL"; if($use_64_bit_int == -1) {} elsif($use_64_bit_int == 1) {$defines .= " -DMATH_MPFR_NEED_LONG_LONG_INT -DIVSIZE_BITS=" . (8 * $Config{ivsize})} else { unless($Config{ivsize} < 8 || $Config{ivtype} eq 'long') { $defines .= " -DMATH_MPFR_NEED_LONG_LONG_INT -DIVSIZE_BITS=" . (8 * $Config{ivsize}); } } if($use_long_double == -1) {} elsif($use_long_double == 1) {$defines .= " -DUSE_LONG_DOUBLE"} else { if($Config::Config{nvsize} > 8 ) { $defines .= " -DUSE_LONG_DOUBLE"; } } $defines .= " -DMPFR_WANT_DECIMAL_FLOATS" if $have_decimal64; $defines .= " -DMPFR_WANT_FLOAT128" if $have_float128; $defines .= " -DNV_IS_FLOAT128" if $Config{nvtype} eq '__float128'; $defines .= " -DNV_IS_LONG_DOUBLE" if $Config{nvtype} eq 'long double'; print "\nThis module requires the following C libraries:\n"; print " gmp-4.2.0 (or later)\n mpfr-2.4.0 (or later)\n\n"; $defines =~ /-DMATH_MPFR_NEED_LONG_LONG_INT/ ? print "Building with 'long long' support\n" : print "Building without 'long long' support\n"; print "If this is wrong, see the \"64-bit support\" section in the README\n\n"; $defines =~ /-DUSE_LONG_DOUBLE/ ? print "Building with 'long double' support\n" : print "Building without 'long double' support\n"; print "If this is wrong, see the \"64-bit support\" section in the README\n\n"; print "\n$d64_message"; print "If this is wrong, see the \"Decimal64 conversion\" section in the README\n\n"; print "\n$float128_message"; print "If this is wrong, see the \"Float128 conversion\" section in the README\n\n"; $defines .= $Config::Config{byteorder} =~ /^1234/ ? " -DMPFR_HAVE_LENDIAN" : " -DMPFR_HAVE_BENDIAN"; my %options = ( NAME => 'Math::MPFR', AUTHOR => 'Sisyphus (sisyphus at (@) cpan dot (.) org)', ABSTRACT => 'Perl interface to the MPFR (floating point) library', DEFINE => $defines, LIBS => [ '-lmpfr -lgmp' ], LICENSE => 'perl', VERSION_FROM => 'MPFR.pm', clean => { FILES => 'out1.txt out2.txt out3.txt out4.txt out5.txt out6.txt out7.txt save_child_setting.txt p_spec.txt' }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/sisyphus/math-mpfr.git', web => 'https://github.com/sisyphus/math-mpfr', }, }, }, ); my %prereq = (); $prereq{'Math::Decimal64'} = '0.01' if $have_decimal64; $prereq{'Math::Float128'} = '0.01' if ($have_float128 && $Config{nvtype} ne '__float128'); $options{PREREQ_PM} = \%prereq; WriteMakefile(%options); # Remove the Makefile dependency. Causes problems on a few systems. sub MY::makefile { '' } Math-MPFR-3.32/MANIFEST0000644000076400010400000000205112660557761015712 0ustar sisyphusAdministratorsMANIFEST Makefile.PL MPFR.pm MPFR.xs README CHANGES Prec/Prec.xs Prec/Prec.pm Prec/Makefile.PL Random/Random.xs Random/Random.pm Random/Makefile.PL demos/doubledouble.p V/V.xs V/V.pm V/Makefile.PL t/_1aaa_v.t t/_1basic.t t/_2exp.t t/base_conversion.t t/bessel.t t/buildopt.t t/bytes.t t/constants.t t/D64_LD.t t/decimal64_conv.t t/div_by_zero.t t/DoubleDouble.t t/DoubleDouble2.t t/exceptions.t t/flags.t t/float128_conv.t t/grandom.t t/integer_string.t t/inits.t t/lngamma_bug.t t/LongDouble.t t/MPFR_RND.t t/nan_cmp.t t/native_float128.t t/neg_zero_bug.t t/not_zero.t t/new.t t/out_str.t t/overload.t t/overload_cross_class.t t/overload_float128.t t/P_specifier.t t/pod.t t/printf.t t/remainder.t t/Rmpfr_get_q.t t/set_NV.t t/set_str.t t/sign.t t/sizes.t t/sum.t t/test1.t t/test2.t t/test3.t t/test4.t t/tls.t t/tls_flags.t t/trig.t t/TRmpfr_out_str.t t/use64bitint.t t/uselongdouble.t typemap META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Math-MPFR-3.32/META.json0000644000076400010400000000214512660557761016206 0ustar sisyphusAdministrators{ "abstract" : "Perl interface to the MPFR (floating point) library", "author" : [ "Sisyphus (sisyphus at (@) cpan dot (.) org)" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-MPFR", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/sisyphus/math-mpfr.git", "web" : "https://github.com/sisyphus/math-mpfr" } }, "version" : "3.32", "x_serialization_backend" : "JSON::PP version 2.27203" } Math-MPFR-3.32/META.yml0000644000076400010400000000117712660557760016041 0ustar sisyphusAdministrators--- abstract: 'Perl interface to the MPFR (floating point) library' author: - 'Sisyphus (sisyphus at (@) cpan dot (.) org)' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Math-MPFR no_index: directory: - t - inc requires: {} resources: repository: https://github.com/sisyphus/math-mpfr.git version: '3.32' x_serialization_backend: 'CPAN::Meta::YAML version 0.011' Math-MPFR-3.32/MPFR.pm0000644000076400010400000034251112660557734015673 0ustar sisyphusAdministrators package Math::MPFR; use strict; use warnings; use POSIX; use Math::MPFR::Prec; use Math::MPFR::Random; use constant GMP_RNDN => 0; use constant GMP_RNDZ => 1; use constant GMP_RNDU => 2; use constant GMP_RNDD => 3; use constant MPFR_RNDN => 0; use constant MPFR_RNDZ => 1; use constant MPFR_RNDU => 2; use constant MPFR_RNDD => 3; use constant MPFR_RNDA => 4; use constant _UOK_T => 1; use constant _IOK_T => 2; use constant _NOK_T => 3; use constant _POK_T => 4; use constant _MATH_MPFR_T => 5; use constant _MATH_GMPf_T => 6; use constant _MATH_GMPq_T => 7; use constant _MATH_GMPz_T => 8; use constant _MATH_GMP_T => 9; use constant _MATH_MPC_T => 10; use subs qw(MPFR_VERSION MPFR_VERSION_MAJOR MPFR_VERSION_MINOR MPFR_VERSION_PATCHLEVEL MPFR_VERSION_STRING RMPFR_PREC_MIN RMPFR_PREC_MAX MPFR_DBL_DIG MPFR_LDBL_DIG MPFR_FLT128_DIG GMP_LIMB_BITS GMP_NAIL_BITS); use overload '++' => \&overload_inc, '--' => \&overload_dec, '+' => \&overload_add, '-' => \&overload_sub, '*' => \&overload_mul, '/' => \&overload_div, '+=' => \&overload_add_eq, '-=' => \&overload_sub_eq, '*=' => \&overload_mul_eq, '/=' => \&overload_div_eq, '""' => \&overload_string, '>' => \&overload_gt, '>=' => \&overload_gte, '<' => \&overload_lt, '<=' => \&overload_lte, '<=>' => \&overload_spaceship, '==' => \&overload_equiv, '!=' => \&overload_not_equiv, '!' => \&overload_not, 'bool' => \&overload_true, '=' => \&overload_copy, 'abs' => \&overload_abs, '**' => \&overload_pow, '**=' => \&overload_pow_eq, 'atan2'=> \&overload_atan2, 'cos' => \&overload_cos, 'sin' => \&overload_sin, 'log' => \&overload_log, 'exp' => \&overload_exp, 'int' => \&overload_int, 'sqrt' => \&overload_sqrt; require Exporter; *import = \&Exporter::import; require DynaLoader; @Math::MPFR::EXPORT_OK = qw(GMP_RNDN GMP_RNDZ GMP_RNDU GMP_RNDD MPFR_RNDN MPFR_RNDZ MPFR_RNDU MPFR_RNDD MPFR_RNDA MPFR_VERSION MPFR_VERSION_MAJOR MPFR_VERSION_MINOR MPFR_VERSION_PATCHLEVEL MPFR_VERSION_STRING RMPFR_VERSION_NUM RMPFR_PREC_MIN RMPFR_PREC_MAX Rmpfr_randclear Rmpfr_randinit_mt Rmpfr_randinit_default Rmpfr_randinit_lc_2exp Rmpfr_randinit_lc_2exp_size Rmpfr_randseed Rmpfr_randseed_ui Rmpfr_abs Rmpfr_acos Rmpfr_acosh Rmpfr_add Rmpfr_add_q Rmpfr_add_si Rmpfr_add_ui Rmpfr_add_z Rmpfr_agm Rmpfr_asin Rmpfr_asinh Rmpfr_atan Rmpfr_atan2 Rmpfr_atanh Rmpfr_can_round Rmpfr_cbrt Rmpfr_ceil Rmpfr_check_range Rmpfr_clear Rmpfr_clears Rmpfr_clear_erangeflag Rmpfr_clear_flags Rmpfr_clear_inexflag Rmpfr_clear_nanflag Rmpfr_clear_overflow Rmpfr_clear_underflow Rmpfr_cmp Rmpfr_cmp_d Rmpfr_cmp_f Rmpfr_cmp_ld Rmpfr_cmp_q Rmpfr_cmp_si Rmpfr_cmp_si_2exp Rmpfr_cmp_ui Rmpfr_cmp_ui_2exp Rmpfr_cmp_z Rmpfr_cmpabs Rmpfr_const_catalan Rmpfr_const_euler Rmpfr_const_log2 Rmpfr_const_pi Rmpfr_cos Rmpfr_cosh Rmpfr_cot Rmpfr_coth Rmpfr_csc Rmpfr_csch Rmpfr_deref2 Rmpfr_dim Rmpfr_div Rmpfr_div_2exp Rmpfr_div_2si Rmpfr_div_2ui Rmpfr_div_q Rmpfr_div_si Rmpfr_div_ui Rmpfr_div_z Rmpfr_dump Rmpfr_eint Rmpfr_eq Rmpfr_equal_p Rmpfr_erangeflag_p Rmpfr_erf Rmpfr_erfc Rmpfr_exp Rmpfr_exp10 Rmpfr_exp2 Rmpfr_expm1 Rmpfr_fac_ui Rmpfr_fits_intmax_p Rmpfr_fits_sint_p Rmpfr_fits_slong_p Rmpfr_fits_sshort_p Rmpfr_fits_uint_p Rmpfr_fits_uintmax_p Rmpfr_fits_ulong_p Rmpfr_fits_IV_p Rmpfr_fits_UV_p Rmpfr_fits_ushort_p Rmpfr_floor Rmpfr_fma Rmpfr_frac Rmpfr_free_cache Rmpfr_gamma Rmpfr_get_d Rmpfr_get_IV Rmpfr_get_UV Rmpfr_get_NV Rmpfr_get_d_2exp Rmpfr_get_d1 Rmpfr_get_default_prec Rmpfr_get_default_rounding_mode Rmpfr_get_emax Rmpfr_get_emax_max Rmpfr_get_emax_min Rmpfr_get_emin Rmpfr_get_emin_max Rmpfr_get_emin_min Rmpfr_get_exp Rmpfr_get_f Rmpfr_get_ld Rmpfr_get_LD Rmpfr_get_ld_2exp Rmpfr_get_prec Rmpfr_get_si Rmpfr_get_sj Rmpfr_get_str Rmpfr_get_ui Rmpfr_get_uj Rmpfr_get_q Rmpfr_get_version Rmpfr_get_z Rmpfr_get_z_exp Rmpfr_get_z_2exp Rmpfr_greater_p Rmpfr_greaterequal_p Rmpfr_hypot Rmpfr_inexflag_p Rmpfr_inf_p Rmpfr_init Rmpfr_init2 Rmpfr_init2_nobless Rmpfr_inits Rmpfr_inits2 Rmpfr_inits_nobless Rmpfr_inits2_nobless Rmpfr_init_nobless Rmpfr_init_set Rmpfr_init_set_d Rmpfr_init_set_d_nobless Rmpfr_init_set_f Rmpfr_init_set_f_nobless Rmpfr_init_set_nobless Rmpfr_init_set_q Rmpfr_init_set_q_nobless Rmpfr_init_set_si Rmpfr_init_set_si_nobless Rmpfr_init_set_str Rmpfr_init_set_str_nobless Rmpfr_init_set_ui Rmpfr_init_set_ui_nobless Rmpfr_init_set_z Rmpfr_init_set_z_nobless Rmpfr_inp_str TRmpfr_inp_str Rmpfr_integer_p Rmpfr_integer_string Rmpfr_less_p Rmpfr_lessequal_p Rmpfr_lessgreater_p Rmpfr_lngamma Rmpfr_log Rmpfr_log10 Rmpfr_log1p Rmpfr_log2 Rmpfr_max Rmpfr_min Rmpfr_min_prec Rmpfr_mul Rmpfr_mul_2exp Rmpfr_mul_2si Rmpfr_mul_2ui Rmpfr_mul_q Rmpfr_mul_si Rmpfr_mul_ui Rmpfr_mul_z Rmpfr_nan_p Rmpfr_nanflag_p Rmpfr_neg Rmpfr_nextabove Rmpfr_nextbelow Rmpfr_nexttoward Rmpfr_number_p Rmpfr_out_str TRmpfr_out_str Rmpfr_overflow_p Rmpfr_pow Rmpfr_pow_si Rmpfr_pow_ui Rmpfr_pow_z Rmpfr_prec_round Rmpfr_print_rnd_mode Rmpfr_random2 Rmpfr_reldiff Rmpfr_rint Rmpfr_rint_ceil Rmpfr_rint_floor Rmpfr_rint_round Rmpfr_rint_trunc Rmpfr_root Rmpfr_round Rmpfr_sec Rmpfr_sech Rmpfr_set Rmpfr_set_d Rmpfr_set_default_prec Rmpfr_set_default_rounding_mode Rmpfr_set_emax Rmpfr_set_emin Rmpfr_set_erangeflag Rmpfr_set_exp Rmpfr_set_f Rmpfr_set_inexflag Rmpfr_set_inf Rmpfr_set_ld Rmpfr_set_LD Rmpfr_set_NV Rmpfr_set_nan Rmpfr_set_nanflag Rmpfr_set_overflow Rmpfr_set_prec Rmpfr_set_prec_raw Rmpfr_set_q Rmpfr_set_si Rmpfr_set_si_2exp Rmpfr_set_sj Rmpfr_set_sj_2exp Rmpfr_set_str Rmpfr_set_ui Rmpfr_set_ui_2exp Rmpfr_set_uj Rmpfr_set_uj_2exp Rmpfr_set_DECIMAL64 Rmpfr_get_DECIMAL64 Rmpfr_set_float128 Rmpfr_get_float128 Rmpfr_set_FLOAT128 Rmpfr_get_FLOAT128 Rmpfr_set_underflow Rmpfr_set_z Rmpfr_sgn Rmpfr_si_div Rmpfr_si_sub Rmpfr_sin Rmpfr_sin_cos Rmpfr_sinh_cosh Rmpfr_sinh Rmpfr_sqr Rmpfr_sqrt Rmpfr_sqrt_ui Rmpfr_strtofr Rmpfr_sub Rmpfr_sub_q Rmpfr_sub_si Rmpfr_sub_ui Rmpfr_sub_z Rmpfr_subnormalize Rmpfr_sum Rmpfr_swap Rmpfr_tan Rmpfr_tanh Rmpfr_trunc Rmpfr_ui_div Rmpfr_ui_pow Rmpfr_ui_pow_ui Rmpfr_ui_sub Rmpfr_underflow_p Rmpfr_unordered_p Rmpfr_urandomb Rmpfr_zero_p Rmpfr_zeta Rmpfr_zeta_ui Rmpfr_j0 Rmpfr_j1 Rmpfr_jn Rmpfr_y0 Rmpfr_y1 Rmpfr_yn Rmpfr_lgamma Rmpfr_signbit Rmpfr_setsign Rmpfr_copysign Rmpfr_get_patches Rmpfr_remainder Rmpfr_remquo Rmpfr_fms Rmpfr_init_set_ld Rmpfr_add_d Rmpfr_sub_d Rmpfr_d_sub Rmpfr_mul_d Rmpfr_div_d Rmpfr_d_div Rmpfr_rec_sqrt Rmpfr_li2 Rmpfr_modf Rmpfr_fmod Rmpfr_printf Rmpfr_fprintf Rmpfr_sprintf Rmpfr_snprintf Rmpfr_buildopt_tls_p Rmpfr_buildopt_decimal_p Rmpfr_regular_p Rmpfr_set_zero Rmpfr_digamma Rmpfr_ai Rmpfr_set_flt Rmpfr_get_flt Rmpfr_urandom Rmpfr_set_z_2exp Rmpfr_set_divby0 Rmpfr_clear_divby0 Rmpfr_divby0_p Rmpfr_buildopt_tune_case Rmpfr_frexp Rmpfr_grandom Rmpfr_z_sub Rmpfr_buildopt_gmpinternals_p prec_cast bytes MPFR_DBL_DIG MPFR_LDBL_DIG MPFR_FLT128_DIG mpfr_max_orig_len mpfr_min_inter_prec mpfr_min_inter_base mpfr_max_orig_base ); our $VERSION = '3.32'; #$VERSION = eval $VERSION; DynaLoader::bootstrap Math::MPFR $VERSION; %Math::MPFR::EXPORT_TAGS =(mpfr => [qw( GMP_RNDN GMP_RNDZ GMP_RNDU GMP_RNDD MPFR_RNDN MPFR_RNDZ MPFR_RNDU MPFR_RNDD MPFR_RNDA MPFR_VERSION MPFR_VERSION_MAJOR MPFR_VERSION_MINOR MPFR_VERSION_PATCHLEVEL MPFR_VERSION_STRING RMPFR_VERSION_NUM RMPFR_PREC_MIN RMPFR_PREC_MAX Rmpfr_randclear Rmpfr_randinit_mt Rmpfr_randinit_default Rmpfr_randinit_lc_2exp Rmpfr_randinit_lc_2exp_size Rmpfr_randseed Rmpfr_randseed_ui Rmpfr_abs Rmpfr_acos Rmpfr_acosh Rmpfr_add Rmpfr_add_q Rmpfr_add_si Rmpfr_add_ui Rmpfr_add_z Rmpfr_agm Rmpfr_asin Rmpfr_asinh Rmpfr_atan Rmpfr_atan2 Rmpfr_atanh Rmpfr_can_round Rmpfr_cbrt Rmpfr_ceil Rmpfr_check_range Rmpfr_clear Rmpfr_clears Rmpfr_clear_erangeflag Rmpfr_clear_flags Rmpfr_clear_inexflag Rmpfr_clear_nanflag Rmpfr_clear_overflow Rmpfr_clear_underflow Rmpfr_cmp Rmpfr_cmp_d Rmpfr_cmp_f Rmpfr_cmp_ld Rmpfr_cmp_q Rmpfr_cmp_si Rmpfr_cmp_si_2exp Rmpfr_cmp_ui Rmpfr_cmp_ui_2exp Rmpfr_cmp_z Rmpfr_cmpabs Rmpfr_const_catalan Rmpfr_const_euler Rmpfr_const_log2 Rmpfr_const_pi Rmpfr_cos Rmpfr_cosh Rmpfr_cot Rmpfr_coth Rmpfr_csc Rmpfr_csch Rmpfr_deref2 Rmpfr_dim Rmpfr_div Rmpfr_div_2exp Rmpfr_div_2si Rmpfr_div_2ui Rmpfr_div_q Rmpfr_div_si Rmpfr_div_ui Rmpfr_div_z Rmpfr_dump Rmpfr_eint Rmpfr_eq Rmpfr_equal_p Rmpfr_erangeflag_p Rmpfr_erf Rmpfr_erfc Rmpfr_exp Rmpfr_exp10 Rmpfr_exp2 Rmpfr_expm1 Rmpfr_fac_ui Rmpfr_fits_intmax_p Rmpfr_fits_sint_p Rmpfr_fits_slong_p Rmpfr_fits_sshort_p Rmpfr_fits_uint_p Rmpfr_fits_uintmax_p Rmpfr_fits_ulong_p Rmpfr_fits_IV_p Rmpfr_fits_UV_p Rmpfr_fits_ushort_p Rmpfr_floor Rmpfr_fma Rmpfr_frac Rmpfr_free_cache Rmpfr_gamma Rmpfr_get_d Rmpfr_get_IV Rmpfr_get_UV Rmpfr_get_NV Rmpfr_get_d_2exp Rmpfr_get_d1 Rmpfr_get_default_prec Rmpfr_get_default_rounding_mode Rmpfr_get_emax Rmpfr_get_emax_max Rmpfr_get_emax_min Rmpfr_get_emin Rmpfr_get_emin_max Rmpfr_get_emin_min Rmpfr_get_exp Rmpfr_get_f Rmpfr_get_ld Rmpfr_get_LD Rmpfr_get_ld_2exp Rmpfr_get_prec Rmpfr_get_si Rmpfr_get_sj Rmpfr_get_str Rmpfr_get_ui Rmpfr_get_uj Rmpfr_get_version Rmpfr_get_z Rmpfr_get_z_exp Rmpfr_get_z_2exp Rmpfr_greater_p Rmpfr_greaterequal_p Rmpfr_hypot Rmpfr_get_q Rmpfr_inexflag_p Rmpfr_inf_p Rmpfr_init Rmpfr_init2 Rmpfr_init2_nobless Rmpfr_inits Rmpfr_inits2 Rmpfr_inits_nobless Rmpfr_inits2_nobless Rmpfr_init_nobless Rmpfr_init_set Rmpfr_init_set_d Rmpfr_init_set_d_nobless Rmpfr_init_set_f Rmpfr_init_set_f_nobless Rmpfr_init_set_nobless Rmpfr_init_set_q Rmpfr_init_set_q_nobless Rmpfr_init_set_si Rmpfr_init_set_si_nobless Rmpfr_init_set_str Rmpfr_init_set_str_nobless Rmpfr_init_set_ui Rmpfr_init_set_ui_nobless Rmpfr_init_set_z Rmpfr_init_set_z_nobless Rmpfr_inp_str TRmpfr_inp_str Rmpfr_integer_p Rmpfr_integer_string Rmpfr_less_p Rmpfr_lessequal_p Rmpfr_lessgreater_p Rmpfr_lngamma Rmpfr_log Rmpfr_log10 Rmpfr_log1p Rmpfr_log2 Rmpfr_max Rmpfr_min Rmpfr_min_prec Rmpfr_mul Rmpfr_mul_2exp Rmpfr_mul_2si Rmpfr_mul_2ui Rmpfr_mul_q Rmpfr_mul_si Rmpfr_mul_ui Rmpfr_mul_z Rmpfr_nan_p Rmpfr_nanflag_p Rmpfr_neg Rmpfr_nextabove Rmpfr_nextbelow Rmpfr_nexttoward Rmpfr_number_p Rmpfr_out_str TRmpfr_out_str Rmpfr_overflow_p Rmpfr_pow Rmpfr_pow_si Rmpfr_pow_ui Rmpfr_pow_z Rmpfr_prec_round Rmpfr_print_rnd_mode Rmpfr_random2 Rmpfr_reldiff Rmpfr_rint Rmpfr_rint_ceil Rmpfr_rint_floor Rmpfr_rint_round Rmpfr_rint_trunc Rmpfr_root Rmpfr_round Rmpfr_sec Rmpfr_sech Rmpfr_set Rmpfr_set_d Rmpfr_set_default_prec Rmpfr_set_default_rounding_mode Rmpfr_set_emax Rmpfr_set_emin Rmpfr_set_erangeflag Rmpfr_set_exp Rmpfr_set_f Rmpfr_set_inexflag Rmpfr_set_inf Rmpfr_set_ld Rmpfr_set_LD Rmpfr_set_NV Rmpfr_set_nan Rmpfr_set_nanflag Rmpfr_set_overflow Rmpfr_set_prec Rmpfr_set_prec_raw Rmpfr_set_q Rmpfr_set_si Rmpfr_set_si_2exp Rmpfr_set_sj Rmpfr_set_sj_2exp Rmpfr_set_str Rmpfr_set_ui Rmpfr_set_ui_2exp Rmpfr_set_uj Rmpfr_set_uj_2exp Rmpfr_set_DECIMAL64 Rmpfr_get_DECIMAL64 Rmpfr_set_float128 Rmpfr_get_float128 Rmpfr_set_FLOAT128 Rmpfr_get_FLOAT128 Rmpfr_set_underflow Rmpfr_set_z Rmpfr_sgn Rmpfr_si_div Rmpfr_si_sub Rmpfr_sin Rmpfr_sin_cos Rmpfr_sinh_cosh Rmpfr_sinh Rmpfr_sqr Rmpfr_sqrt Rmpfr_sqrt_ui Rmpfr_strtofr Rmpfr_sub Rmpfr_sub_q Rmpfr_sub_si Rmpfr_sub_ui Rmpfr_sub_z Rmpfr_subnormalize Rmpfr_sum Rmpfr_swap Rmpfr_tan Rmpfr_tanh Rmpfr_trunc Rmpfr_ui_div Rmpfr_ui_pow Rmpfr_ui_pow_ui Rmpfr_ui_sub Rmpfr_underflow_p Rmpfr_unordered_p Rmpfr_urandomb Rmpfr_zero_p Rmpfr_zeta Rmpfr_zeta_ui Rmpfr_j0 Rmpfr_j1 Rmpfr_jn Rmpfr_y0 Rmpfr_y1 Rmpfr_yn Rmpfr_lgamma Rmpfr_signbit Rmpfr_setsign Rmpfr_copysign Rmpfr_get_patches Rmpfr_remainder Rmpfr_remquo Rmpfr_fms Rmpfr_init_set_ld Rmpfr_add_d Rmpfr_sub_d Rmpfr_d_sub Rmpfr_mul_d Rmpfr_div_d Rmpfr_d_div Rmpfr_rec_sqrt Rmpfr_li2 Rmpfr_modf Rmpfr_fmod Rmpfr_printf Rmpfr_fprintf Rmpfr_sprintf Rmpfr_snprintf Rmpfr_buildopt_tls_p Rmpfr_buildopt_decimal_p Rmpfr_regular_p Rmpfr_set_zero Rmpfr_digamma Rmpfr_ai Rmpfr_set_flt Rmpfr_get_flt Rmpfr_urandom Rmpfr_set_z_2exp Rmpfr_set_divby0 Rmpfr_clear_divby0 Rmpfr_divby0_p Rmpfr_buildopt_tune_case Rmpfr_frexp Rmpfr_grandom Rmpfr_z_sub Rmpfr_buildopt_gmpinternals_p prec_cast MPFR_DBL_DIG MPFR_LDBL_DIG MPFR_FLT128_DIG mpfr_max_orig_len mpfr_min_inter_prec mpfr_min_inter_base mpfr_max_orig_base )]); $Math::MPFR::NNW = 0; # Set to 1 to allow "non-numeric" warnings for operations involving # strings that contain non-numeric characters. sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking sub Rmpfr_out_str { if(@_ == 4) { die "Inappropriate 1st arg supplied to Rmpfr_out_str" if _itsa($_[0]) != _MATH_MPFR_T; return _Rmpfr_out_str($_[0], $_[1], $_[2], $_[3]); } if(@_ == 5) { if(_itsa($_[0]) == _MATH_MPFR_T) {return _Rmpfr_out_strS($_[0], $_[1], $_[2], $_[3], $_[4])} die "Incorrect args supplied to Rmpfr_out_str" if _itsa($_[1]) != _MATH_MPFR_T; return _Rmpfr_out_strP($_[0], $_[1], $_[2], $_[3], $_[4]); } if(@_ == 6) { die "Inappropriate 2nd arg supplied to Rmpfr_out_str" if _itsa($_[1]) != _MATH_MPFR_T; return _Rmpfr_out_strPS($_[0], $_[1], $_[2], $_[3], $_[4], $_[5]); } die "Wrong number of arguments supplied to Rmpfr_out_str()"; } sub TRmpfr_out_str { if(@_ == 5) { die "Inappropriate 4th arg supplied to TRmpfr_out_str" if _itsa($_[3]) != _MATH_MPFR_T; return _TRmpfr_out_str($_[0], $_[1], $_[2], $_[3], $_[4]); } if(@_ == 6) { if(_itsa($_[3]) == _MATH_MPFR_T) {return _TRmpfr_out_strS($_[0], $_[1], $_[2], $_[3], $_[4], $_[5])} die "Incorrect args supplied to TRmpfr_out_str" if _itsa($_[4]) != _MATH_MPFR_T; return _TRmpfr_out_strP($_[0], $_[1], $_[2], $_[3], $_[4], $_[5]); } if(@_ == 7) { die "Inappropriate 5th arg supplied to TRmpfr_out_str" if _itsa($_[4]) != _MATH_MPFR_T; return _TRmpfr_out_strPS($_[0], $_[1], $_[2], $_[3], $_[4], $_[5], $_[6]); } die "Wrong number of arguments supplied to TRmpfr_out_str()"; } sub Rmpfr_get_str { my ($mantissa, $exponent) = Rmpfr_deref2($_[0], $_[1], $_[2], $_[3]); if($mantissa =~ /\@Inf\@/i || $mantissa =~ /\@NaN\@/i) {return $mantissa} if($mantissa =~ /\-/ && $mantissa !~ /[^0,\-]/) {return '-0'} if($mantissa !~ /[^0]/ ) {return '0'} my $len = substr($mantissa, 0, 1) eq '-' ? 2 : 1; if(!$_[2]) { while(length($mantissa) > $len && substr($mantissa, -1, 1) eq '0') { substr($mantissa, -1, 1, ''); } } $exponent--; my $sep = $_[1] <= 10 ? 'e' : '@'; if(length($mantissa) == $len) { if($exponent) {return $mantissa . $sep . $exponent} return $mantissa; } substr($mantissa, $len, 0, '.'); if($exponent) {return $mantissa . $sep . $exponent} return $mantissa; } sub overload_string { return Rmpfr_get_str($_[0], 10, 0, Rmpfr_get_default_rounding_mode()); } sub Rmpfr_integer_string { if($_[1] < 2 || $_[1] > 36) {die("Second argument supplied to Rmpfr_integer_string() is not in acceptable range")} my($mantissa, $exponent) = Rmpfr_deref2($_[0], $_[1], 0, $_[2]); if($mantissa =~ /\@Inf\@/i || $mantissa =~ /\@NaN\@/i) {return $mantissa} if($mantissa =~ /\-/ && $mantissa !~ /[^0,\-]/) {return '-0'} return 0 if $exponent < 1; my $sign = substr($mantissa, 0, 1) eq '-' ? 1 : 0; $mantissa = substr($mantissa, 0, $exponent + $sign); return $mantissa; } sub new { # This function caters for 2 possibilities: # 1) that 'new' has been called OOP style - in which # case there will be a maximum of 3 args # 2) that 'new' has been called as a function - in # which case there will be a maximum of 2 args. # If there are no args, then we just want to return an # initialized Math::MPFR object if(!@_) {return Rmpfr_init()} if(@_ > 3) {die "Too many arguments supplied to new()"} # If 'new' has been called OOP style, the first arg is the string # "Math::MPFR" which we don't need - so let's remove it. However, # if the first arg is a Math::MPFR object (which is a possibility), # then we'll get a fatal error when we check it for equivalence to # the string "Math::MPFR". So we first need to check that it's not # an object - which we'll do by using the ref() function: if(!ref($_[0]) && $_[0] eq "Math::MPFR") { shift; if(!@_) {return Rmpfr_init()} } # @_ can now contain a maximum of 2 args - the value, and iff the value is # a string, (optionally) the base of the numeric string. if(@_ > 2) {die "Too many arguments supplied to new() - expected no more than two"} my ($arg1, $type, $base); # $_[0] is the value, $_[1] (if supplied) is the base of the number # in the string $[_0]. $arg1 = shift; $base = 0; $type = _itsa($arg1); if(!$type) {die "Inappropriate argument supplied to new()"} my @ret; # Create a Math::MPFR object that has $arg1 as its value. # Die if there are any additional args (unless $type == 4) if($type == _UOK_T) { if(@_ ) {die "Too many arguments supplied to new() - expected only one"} if(Math::MPFR::_has_longlong()) { my $ret = Rmpfr_init(); Rmpfr_set_uj($ret, $arg1, Rmpfr_get_default_rounding_mode()); return $ret; } else { @ret = Rmpfr_init_set_ui($arg1, Rmpfr_get_default_rounding_mode()); return $ret[0]; } } if($type == _IOK_T) { if(@_ ) {die "Too many arguments supplied to new() - expected only one"} if(Math::MPFR::_has_longlong()) { my $ret = Rmpfr_init(); Rmpfr_set_sj($ret, $arg1, Rmpfr_get_default_rounding_mode()); return $ret; } else { @ret = Rmpfr_init_set_si($arg1, Rmpfr_get_default_rounding_mode()); return $ret[0]; } } if($type == _NOK_T) { if(@_ ) {die "Too many arguments supplied to new() - expected only one"} my $ret = Rmpfr_init(); Rmpfr_set_NV($ret, $arg1, Rmpfr_get_default_rounding_mode()); return $ret; } if($type == _POK_T) { if(@_ > 1) {die "Too many arguments supplied to new() - expected no more than two"} $base = shift if @_; if($base < 0 || $base == 1 || $base > 36) {die "Invalid value for base"} @ret = Rmpfr_init_set_str($arg1, $base, Rmpfr_get_default_rounding_mode()); return $ret[0]; } if($type == _MATH_MPFR_T) { if(@_) {die "Too many arguments supplied to new() - expected only one"} @ret = Rmpfr_init_set($arg1, Rmpfr_get_default_rounding_mode()); return $ret[0]; } if($type == _MATH_GMPf_T) { if(@_) {die "Too many arguments supplied to new() - expected only one"} @ret = Rmpfr_init_set_f($arg1, Rmpfr_get_default_rounding_mode()); return $ret[0]; } if($type == _MATH_GMPq_T) { if(@_) {die "Too many arguments supplied to new() - expected only one"} @ret = Rmpfr_init_set_q($arg1, Rmpfr_get_default_rounding_mode()); return $ret[0]; } if($type == _MATH_GMPz_T || $type == _MATH_GMP_T) { if(@_) {die "Too many arguments supplied to new() - expected only one"} @ret = Rmpfr_init_set_z($arg1, Rmpfr_get_default_rounding_mode()); return $ret[0]; } } sub Rmpfr_printf { if(@_ == 3){wrap_mpfr_printf_rnd(@_)} else {die "Rmpfr_printf must take 2 or 3 arguments: format string, [rounding,], and variable" if @_ != 2; wrap_mpfr_printf(@_)} } sub Rmpfr_fprintf { if(@_ == 4){wrap_mpfr_fprintf_rnd(@_)} else {die "Rmpfr_fprintf must take 3 or 4 arguments: filehandle, format string, [rounding,], and variable" if @_ != 3; wrap_mpfr_fprintf(@_)} } sub Rmpfr_sprintf { my $len; if(@_ == 5){ $len = wrap_mpfr_sprintf_rnd(@_); return $len; } die "Rmpfr_sprintf must take 4 or 5 arguments: buffer, format string, [rounding,], variable and buffer size" if @_ != 4; $len = wrap_mpfr_sprintf(@_); return $len; } sub Rmpfr_snprintf { my $len; if(@_ == 6){ $len = wrap_mpfr_snprintf_rnd(@_); return $len; } die "Rmpfr_snprintf must take 5 or 6 arguments: buffer, bytes written, format string, [rounding,], variable and buffer size" if @_ != 5; $len = wrap_mpfr_snprintf(@_); return $len; } sub Rmpfr_inits { my @ret; for(1 .. $_[0]) { $ret[$_ - 1] = Rmpfr_init(); } return @ret; } sub Rmpfr_inits2 { my @ret; for(1 .. $_[1]) { $ret[$_ - 1] = Rmpfr_init2($_[0]); } return @ret; } sub Rmpfr_inits_nobless { my @ret; for(1 .. $_[0]) { $ret[$_ - 1] = Rmpfr_init_nobless(); } return @ret; } sub Rmpfr_inits2_nobless { my @ret; for(1 .. $_[1]) { $ret[$_ - 1] = Rmpfr_init2_nobless($_[0]); } return @ret; } sub MPFR_VERSION {return _MPFR_VERSION()} sub MPFR_VERSION_MAJOR {return _MPFR_VERSION_MAJOR()} sub MPFR_VERSION_MINOR {return _MPFR_VERSION_MINOR()} sub MPFR_VERSION_PATCHLEVEL {return _MPFR_VERSION_PATCHLEVEL()} sub MPFR_VERSION_STRING {return _MPFR_VERSION_STRING()} sub MPFR_DBL_DIG {return _DBL_DIG()} sub MPFR_LDBL_DIG {return _LDBL_DIG()} sub MPFR_FLT128_DIG {return _FLT128_DIG()} sub GMP_LIMB_BITS {return _GMP_LIMB_BITS()} sub GMP_NAIL_BITS {return _GMP_NAIL_BITS()} sub mpfr_min_inter_prec { die "Wrong number of args to minimum_intermediate_prec()" if @_ != 3; my $orig_base = shift; my $orig_length = shift; my $to_base = shift; return ceil(1 + ($orig_length * log($orig_base) / log($to_base))); } sub mpfr_min_inter_base { die "Wrong number of args to minimum_intermediate_base()" if @_ != 3; my $orig_base = shift; my $orig_length = shift; my $to_prec = shift; return ceil(exp($orig_length * log($orig_base) / ($to_prec - 1))); } sub mpfr_max_orig_len { die "Wrong number of args to maximum_orig_length()" if @_ != 3; my $orig_base = shift; my $to_base = shift; my $to_prec = shift; return floor(1 / (log($orig_base) / log($to_base) / ($to_prec - 1))); } sub mpfr_max_orig_base { die "Wrong number of args to maximum_orig_base()" if @_ != 3; my $orig_length = shift; my $to_base = shift; my $to_prec = shift; return floor(exp(1 / ($orig_length / log($to_base) / ($to_prec -1)))); } sub bytes { my($val, $type, $ret) = (shift, shift); my $itsa = _itsa($val); die "1st arg to Math::MPFR::bytes must be either a string or a Math::MPFR object" if($itsa != 4 && $itsa != 5); if(lc($type) eq 'double') { $ret = $itsa == 4 ? join '', _d_bytes ($val, 53) : join '', _d_bytes_fr($val, 53); return $ret; } if(lc($type) eq 'long double') { $ret = $itsa == 4 ? join '', _ld_bytes ($val, 64) : join '', _ld_bytes_fr($val, 64); return $ret; } if(lc($type) eq 'double-double') { $ret = $itsa == 4 ? join '', _dd_bytes ($val, 106) : join '', _dd_bytes_fr($val, 106); return $ret; } if(lc($type) eq '__float128') { $ret = $itsa == 4 ? join '', _f128_bytes ($val, 113) : join '', _f128_bytes_fr($val, 113); return $ret; } die "2nd arg to Math::MPFR::bytes must be (case-insensitive) either 'double', 'double-double', 'long double' or '__float128'"; } *Rmpfr_get_z_exp = \&Rmpfr_get_z_2exp; *prec_cast = \&Math::MPFR::Prec::prec_cast; *Rmpfr_randinit_default = \&Math::MPFR::Random::Rmpfr_randinit_default; *Rmpfr_randinit_mt = \&Math::MPFR::Random::Rmpfr_randinit_mt; *Rmpfr_randinit_lc_2exp = \&Math::MPFR::Random::Rmpfr_randinit_lc_2exp; *Rmpfr_randinit_lc_2exp_size = \&Math::MPFR::Random::Rmpfr_randinit_lc_2exp_size; 1; __END__ =head1 NAME Math::MPFR - perl interface to the MPFR (floating point) library. =head1 DEPENDENCIES This module needs the MPFR and GMP C libraries. (Install GMP first as it is a pre-requisite for MPFR.) The GMP library is available from http://gmplib.org The MPFR library is available from http://www.mpfr.org/ =head1 DESCRIPTION A bigfloat module utilising the MPFR library. Basically this module simply wraps the 'mpfr' floating point functions provided by that library. Operator overloading is also available. The following documentation heavily plagiarises the mpfr documentation. See also the Math::MPFR test suite for some examples of usage. =head1 SYNOPSIS use Math::MPFR qw(:mpfr); # '@' can be used to separate mantissa from exponent. For bases # that are <= 10, 'e' or 'E' can also be used. # Use single quotes for string assignment if you're using '@' as # the separator. If you must use double quotes, you'll have to # escape the '@'. my $str = '.123542@2'; # mantissa = (.)123452 # exponent = 2 #Alternatively: # my $str = ".123542\@2"; # or: # my $str = '12.3542'; # or: # my $str = '1.23542e1'; # or: # my $str = '1.23542E1'; my $base = 10; my $rnd = MPFR_RNDZ; # See 'ROUNDING MODE' # Create an Math::MPFR object that holds an initial # value of $str (in base $base) and has the default # precision. $bn1 is the number. $nok will either be 0 # indicating that the string was a valid number string, or # -1, indicating that the string contained at least one # invalid numeric character. # See 'COMBINED INITIALISATION AND ASSIGNMENT', below. my ($bn1, $nok) = Rmpfr_init_set_str($str, $base, $rnd); # Or use the new() constructor - also documented below # in 'COMBINED INITIALISATION AND ASSIGNMENT'. # my $bn1 = Math::MPFR->new($str); # Create another Math::MPFR object with precision # of 100 bits and an initial value of NaN. my $bn2 = Rmpfr_init2(100); # Assign the value -2314.451 to $bn1. Rmpfr_set_d($bn2, -2314.451, MPFR_RNDN); # Create another Math::MPFR object that holds # an initial value of NaN and has the default precision. my $bn3 = Rmpfr_init(); # Or using instead the new() constructor: # my $bn3 = Math::MPFR->new(); # Perform some operations ... see 'FUNCTIONS' below. # see 'OPERATOR OVERLOADING' below for docs re # operator overloading . . # print out the value held by $bn1 (in octal): print Rmpfr_get_str($bn1, 8, 0, $rnd), "\n"; # print out the value held by $bn1 (in decimal): print Rmpfr_get_str($bn1, 10, 0, $rnd), "\n"; # or just make use of overloading : print $bn1, "\n"; # is base 10, and uses 'e' rather than '@'. # print out the value held by $bn1 (in base 16) using the # 'TRmpfr_out_str' function. (No newline is printed - unless # it's supplied as the optional fifth arg. See the # 'TRmpfr_out_str' documentation below.) TRmpfr_out_str(*stdout, 16, 0, $bn1, $rnd); =head1 ROUNDING MODE One of 4 values: GMP_RNDN (numeric value = 0): Round to nearest. GMP_RNDZ (numeric value = 1): Round towards zero. GMP_RNDU (numeric value = 2): Round towards +infinity. GMP_RNDD (numeric value = 3): Round towards -infinity. With the release of mpfr-3.0.0, the same rounding values are renamed to: MPFR_RNDN (numeric value = 0): Round to nearest. MPFR_RNDZ (numeric value = 1): Round towards zero. MPFR_RNDU (numeric value = 2): Round towards +infinity. MPFR_RNDD (numeric value = 3): Round towards -infinity. You can use either rendition with Math-MPFR-3.0 or later. The mpfr-3.0.0 library also provides: MPFR_RNDA (numeric value = 4): Round away from zero. It, too, can be used with Math-MPFR-3.0 or later, but will cause a fatal error iff the mpfr library against which Math::MPFR is built is earlier than version 3.0.0. The `round to nearest' mode works as in the IEEE P754 standard: in case the number to be rounded lies exactly in the middle of two representable numbers, it is rounded to the one with the least significant bit set to zero. For example, the number 5, which is represented by (101) in binary, is rounded to (100)=4 with a precision of two bits, and not to (110)=6. This rule avoids the "drift" phenomenon mentioned by Knuth in volume 2 of The Art of Computer Programming (section 4.2.2, pages 221-222). Most Math::MPFR functions take as first argument the destination variable, as second and following arguments the input variables, as last argument a rounding mode, and have a return value of type `int'. If this value is zero, it usually means that the value stored in the destination variable is the exact result of the corresponding mathematical function. If the returned value is positive (resp. negative), it usually means the value stored in the destination variable is greater (resp. lower) than the exact result. For example with the `GMP_RNDU' rounding mode, the returned value is usually positive, except when the result is exact, in which case it is zero. In the case of an infinite result, it is considered as inexact when it was obtained by overflow, and exact otherwise. A NaN result (Not-a-Number) always corresponds to an inexact return value. =head1 MEMORY MANAGEMENT Objects are created with new() or with the Rmpfr_init* functions. All of these functions return an object that has been blessed into the package Math::MPFR. They will therefore be automatically cleaned up by the DESTROY() function whenever they go out of scope. For each Rmpfr_init* function there is a corresponding function called Rmpfr_init*_nobless which returns an unblessed object. If you create Math::MPFR objects using the '_nobless' versions, it will then be up to you to clean up the memory associated with these objects by calling Rmpfr_clear($op) for each object, or Rmpfr_clears($op1, $op2, ....). Alternatively such objects will be cleaned up when the script ends. I don't know why you would want to create unblessed objects. The point is that you can if you want to. The test suite does no testing of unblessed objects ... beware of bugs if you go down that path. =head1 MIXING GMP OBJECTS WITH MPFR OBJECTS Some of the Math::MPFR functions below take as arguments one or more of the GMP types mpz (integer), mpq (rational) and mpf (floating point). (Such functions are marked as taking mpz/mpq/mpf arguments.) For these functions to work you need to have loaded either: 1) Math::GMP from CPAN. (This module provides access to mpz objects only - NOT mpf and mpq objects.) AND/OR 2) Math::GMPz (for mpz types), Math::GMPq (for mpq types) and Math::GMPf (for mpf types). You may also be able to use objects from the GMP module that ships with the GMP sources. I get occasional segfaults when I try to do that, so I've stopped recommending it - and don't support the practice. =head1 PASSING __float128 VALUES There are 3 ways to pass __float128 values to/from Math::MPFR: 1) Install Math::Float128, build the mpfr-3.2.0 (or later) library with the configure option --enable-float128, and build Math::MPFR by providing the "F128=1" arg to the Makefile.pl: perl Makefile.PL F128=1 Then you can pass the values of the Math::Float128 objects to and from Math::MPFR objects using: Rmpfr_set_FLOAT128() and Rmpfr_get_FLOAT128() 2) Build perl (5.21.4 or later) with -Dusequadmath; build the mpfr-3.2.0 (or later) library with the configure option --enable-float128, and then build Math::MPFR by providing the "F128=1" arg to the Makefile.pl: perl Makefile.PL F128=1 Then you can pass your perl's __float128 NV values directly to/from Math::MPFR using: Rmpfr_set_float128() or Rmpfr_set_NV() and Rmpfr_get_float128() or Rmpfr_get_NV() This will also mean that overloaded operations that receive an NV will evaluate that (__float128) NV to it's full precision. And assigning the NV as Math::MPFR->new($nv) will also work as intended. 3) Convert the __float128 values to a string and pass them to and from Math::MPFR using: Rmpfr_set_str() and Rmpfr_get_str() =head1 FUNCTIONS These next 3 functions are demonstrated above: $rop = Rmpfr_init(); $rop = Rmpfr_init2($p); $str = Rmpfr_get_str($op, $base, $digits, $rnd); # 1 < $base < 37 The third argument to Rmpfr_get_str() specifies the number of digits required to be output in the mantissa. (Trailing zeroes are removed.) If $digits is 0, the number of digits of the mantissa is chosen large enough so that re-reading the printed value with the same precision, assuming both output and input use rounding to nearest, will recover the original value of $op. The following functions are simply wrappers around an mpfr function of the same name. eg. Rmpfr_swap() is a wrapper around mpfr_swap(). "$rop", "$op1", "$op2", etc. are Math::MPFR objects - the return value of one of the Rmpfr_init* functions. They are in fact references to mpfr structures. The "$op" variables are the operands and "$rop" is the variable that stores the result of the operation. Generally, $rop, $op1, $op2, etc. can be the same perl variable referencing the same mpfr structure, though often they will be distinct perl variables referencing distinct mpfr structures. Eg something like Rmpfr_add($r1, $r1, $r1, $rnd), where $r1 *is* the same reference to the same mpfr structure, would add $r1 to itself and store the result in $r1. Alternatively, you could (courtesy of operator overloading) simply code it as $r1 += $r1. Otoh, Rmpfr_add($r1, $r2, $r3, $rnd), where each of the arguments is a different reference to a different mpfr structure would add $r2 to $r3 and store the result in $r1. Alternatively it could be coded as $r1 = $r2 + $r3. "$ui" means any integer that will fit into a C 'unsigned long int', "$si" means any integer that will fit into a C 'signed long int'. "$sj" means any integer that will fit into a C 'intmax_t'. Don't use any of these functions unless your perl was compiled with 64 bit support. "$double" is a C double and "$float" is a C float ... but both will be represented in Perl as an NV. "$bool" means a value (usually a 'signed long int') in which the only interest is whether it evaluates as false or true. "$str" simply means a string of symbols that represent a number, eg '1234567890987654321234567@7' which might be a base 10 number, or 'zsa34760sdfgq123r5@11' which would have to represent at least a base 36 number (because "z" is a valid digit only in bases 36 and above). Valid bases for MPFR numbers are 0 and 2 to 36 (2 to 62 if Math::MPFR has been built against mpfr-3.0.0 or later). "$rnd" is simply one of the 4 rounding mode values (discussed above). "$p" is the (signed int) value for precision. ############## ROUNDING MODES Rmpfr_set_default_rounding_mode($rnd); Sets the default rounding mode to $rnd. The default rounding mode is to nearest initially (GMP_RNDN). The default rounding mode is the rounding mode that is used in overloaded operations. $si = Rmpfr_get_default_rounding_mode(); Returns the numeric value (0, 1, 2 or 3) of the current default rounding mode. This will initially be 0. $si = Rmpfr_prec_round($rop, $p, $rnd); Rounds $rop according to $rnd with precision $p, which may be different from that of $rop. If $p is greater or equal to the precision of $rop, then new space is allocated for the mantissa, and it is filled with zeroes. Otherwise, the mantissa is rounded to precision $p with the given direction. In both cases, the precision of $rop is changed to $p. The returned value is zero when the result is exact, positive when it is greater than the original value of $rop, and negative when it is smaller. The precision $p can be any integer between RMPFR_PREC_MIN and RMPFR_PREC_MAX. ########## EXCEPTIONS $si = Rmpfr_get_emin(); $si = Rmpfr_get_emax(); Return the (current) smallest and largest exponents allowed for a floating-point variable. $si = Rmpfr_get_emin_min(); $si = Rmpfr_get_emin_max(); $si = Rmpfr_get_emax_min(); $si = Rmpfr_get_emax_max(); Return the minimum and maximum of the smallest and largest exponents allowed for `mpfr_set_emin' and `mpfr_set_emax'. These values are implementation dependent $bool = Rmpfr_set_emin($si); $bool = Rmpfr_set_emax($si); Set the smallest and largest exponents allowed for a floating-point variable. Return a non-zero value when $si is not in the range of exponents accepted by the implementation (in that case the smallest or largest exponent is not changed), and zero otherwise. If the user changes the exponent range, it is her/his responsibility to check that all current floating-point variables are in the new allowed range (for example using `Rmpfr_check_range', otherwise the subsequent behaviour will be undefined, in the sense of the ISO C standard. $si2 = Rmpfr_check_range($op, $si1, $rnd); This function has changed from earlier implementations. It now forces $op to be in the current range of acceptable values, $si1 the current ternary value: negative if $op is smaller than the exact value, positive if $op is larger than the exact value and zero if $op is exact (before the call). It generates an underflow or an overflow if the exponent of $op is outside the current allowed range; the value of $si1 may be used to avoid a double rounding. This function returns zero if the rounded result is equal to the exact one, a positive value if the rounded result is larger than the exact one, a negative value if the rounded result is smaller than the exact one. Note that unlike most functions, the result is compared to the exact one, not the input value $op, i.e. the ternary value is propagated. Note: If $op is an infinity and $si1 is different from zero (i.e., if the rounded result is an inexact infinity), then the overflow flag is set. Rmpfr_set_underflow(); Rmpfr_set_overflow(); Rmpfr_set_nanflag(); Rmpfr_set_inexflag(); Rmpfr_set_erangeflag(); Rmpfr_set_divby0(); # mpfr-3.1.0 and later only Rmpfr_clear_underflow(); Rmpfr_clear_overflow(); Rmpfr_clear_nanflag(); Rmpfr_clear_inexflag(); Rmpfr_clear_erangeflag(); Rmpfr_clear_divby0(); # mpfr-3.1.0 and later only Set/clear the underflow, overflow, invalid, inexact, erange and divide-by-zero flags. Rmpfr_clear_flags(); Clear all global flags (underflow, overflow, inexact, invalid, erange and divide-by-zero). $bool = Rmpfr_underflow_p(); $bool = Rmpfr_overflow_p(); $bool = Rmpfr_nanflag_p(); $bool = Rmpfr_inexflag_p(); $bool = Rmpfr_erangeflag_p(); $bool = Rmpfr_divby0_p(); # mpfr-3.1.0 and later only Return the corresponding (underflow, overflow, invalid, inexact, erange, divide-by-zero) flag, which is non-zero iff the flag is set. $si = Rmpfr_subnormalize ($op, $si, $rnd); See the MPFR documentation for mpfr_subnormalize(). ############## INITIALIZATION A variable should be initialized once only. First read the section 'MEMORY MANAGEMENT' (above). Rmpfr_set_default_prec($p); Set the default precision to be *exactly* $p bits. The precision of a variable means the number of bits used to store its mantissa. All subsequent calls to `mpfr_init' will use this precision, but previously initialized variables are unaffected. This default precision is set to 53 bits initially. The precision can be any integer between RMPFR_PREC_MIN and RMPFR_PREC_MAX. $ui = Rmpfr_get_default_prec(); Returns the default MPFR precision in bits. $rop = Math::MPFR->new(); $rop = Math::MPFR::new(); $rop = new Math::MPFR(); $rop = Rmpfr_init(); $rop = Rmpfr_init_nobless(); Initialize $rop, and set its value to NaN. The precision of $rop is the default precision, which can be changed by a call to `Rmpfr_set_default_prec'. $rop = Rmpfr_init2($p); $rop = Rmpfr_init2_nobless($p); Initialize $rop, set its precision to be *exactly* $p bits, and set its value to NaN. To change the precision of a variable which has already been initialized, use `Rmpfr_set_prec' instead. The precision $p can be any integer between RMPFR_PREC_MIN and RMPFR_PREC_MAX. @rops = Rmpfr_inits($how_many); @rops = Rmpfr_inits_nobless($how_many); Returns an array of $how_many Math::MPFR objects - initialized, with a value of NaN, and with default precision. (These functions do not wrap mpfr_inits.) @rops = Rmpfr_inits2($p, $how_many); @rops = Rmpfr_inits2_nobless($p, $how_many); Returns an array of $how_many Math::MPFR objects - initialized, with a value of NaN, and with precision of $p. (These functions do not wrap mpfr_inits2.) Rmpfr_set_prec($op, $p); Reset the precision of $op to be *exactly* $p bits. The previous value stored in $op is lost. The precision $p can be any integer between RMPFR_PREC_MIN and RMPFR_PREC_MAX. If you want to keep the previous value stored in $op, use 'Rmpfr_prec_round' instead. $si = Rmpfr_get_prec($op); Return the precision actually used for assignments of $op, i.e. the number of bits used to store its mantissa. Rmpfr_set_prec_raw($rop, $p); Reset the precision of $rop to be *exactly* $p bits. The only difference with `mpfr_set_prec' is that $p is assumed to be small enough so that the mantissa fits into the current allocated memory space for $rop. Otherwise an error will occur. $min_prec = Rmpfr_min_prec($op); (This function is implemented only when Math::MPFR is built against mpfr-3.0.0 or later. The mpfr_min_prec function was not present in earlier versions of mpfr.) $min_prec is set to the minimal number of bits required to store the significand of $op, and 0 for special values, including 0. (Warning: the returned value can be less than RMPFR_PREC_MIN.) $minimum_precision = RMPFR_PREC_MIN; $maximum_precision = RMPFR_PREC_MAX; Returns the minimum/maximum precision for Math::MPFR objects allowed by the mpfr library being used. ########## ASSIGNMENT $si = Rmpfr_set($rop, $op, $rnd); $si = Rmpfr_set_ui($rop, $ui, $rnd); $si = Rmpfr_set_si($rop, $si, $rnd); $si = Rmpfr_set_sj($rop, $sj, $rnd); # 64 bit $si = Rmpfr_set_uj($rop, $uj, $rnd); # 64 bit $si = Rmpfr_set_d($rop, $double, $rnd); $si = Rmpfr_set_ld($rop, $ld, $rnd); # long double $si = Rmpfr_set_NV($rop, $nv, $rnd); # double/long double/__float128 $si = Rmpfr_set_LD($rop, $LD, $rnd); # $LD is a Math::LongDouble object $si = Rmpfr_set_z($rop, $z, $rnd); # $z is a mpz object. $si = Rmpfr_set_q($rop, $q, $rnd); # $q is a mpq object. $si = Rmpfr_set_f($rop, $f, $rnd); # $f is a mpf object. $si = Rmpfr_set_flt($rop, $float, $rnd); # mpfr-3.0.0 and later only $si = Rmpfr_set_float128($rop, $f128, $rnd); # mpfr-3.2.0 and later $si = Rmpfr_set_DECIMAL64($rop, $D64, $rnd) # mpfr-3.1.1 and later # only. $D64 is a # Math::Decimal64 object $si = Rmpfr_set_FLOAT128($rop, $F128, $rnd) # mpfr-3.2.0 and later # only. $F128 is a # Math::Float128 object Set the value of $rop from 2nd arg, rounded to the precision of $rop towards the given direction $rnd. Please note that even a 'long int' may have to be rounded if the destination precision is less than the machine word width. The return value is zero when $rop=2nd arg, positive when $rop>2nd arg, and negative when $rop<2nd arg. For `mpfr_set_d', be careful that the input number $double may not be exactly representable as a double-precision number (this happens for 0.1 for instance), in which case it is first rounded by the C compiler to a double-precision number, and then only to a mpfr floating-point number. NOTE: If your perl's nvtype is 'long double' use Rmpfr_set_ld() or Rmpfr_set_NV(), but if your perl's nvtype is 'double' and you want to set a value whose precision is that of 'long double', then install Math::LongDouble and use Rmpfr_set_LD(). Rmpfr_set_NV simply calls either mpfr_set_ld, mpfr_set_ld, or mpfr_set_float128 as appropriate for your Math::MPFR and perl configuration. $si = Rmpfr_set_ui_2exp($rop, $ui, $exp, $rnd); $si = Rmpfr_set_si_2exp($rop, $si, $exp, $rnd); $si = Rmpfr_set_uj_2exp($rop, $sj, $exp, $rnd); # 64 bit $si = Rmpfr_set_sj_2exp($rop, $sj, $exp, $rnd); # 64 bit $si = Rmpfr_set_z_2exp($rop, $z, $exp, $rnd); # mpfr-3.0.0 and later only Set the value of $rop from the 2nd arg multiplied by two to the power $exp, rounded towards the given direction $rnd. Note that the input 0 is converted to +0. ($z is a GMP mpz object.) $si = Rmpfr_set_str($rop, $str, $base, $rnd); Set $rop to the value of $str in base $base (0,2..36 or, if Math::MPFR has been built against mpfr-3.0.0 or later, (0,2..62), rounded in direction $rnd to the precision of $rop. The exponent is read in decimal. This function returns 0 if the entire string is a valid number in base $base. otherwise it returns -1. If -1 is returned: 1) the non-numeric flag (which was initalised to 0) will be incremented. You can query/clear/reset the value of the flag with (resp.) nnumflag()/clear_nnum()/set_nnum() - all of which are documented below (in "MISCELLANEOUS"); 2) A warning will be emitted if $Math::MPFR::NNW is set to 1 (default is 0). If $base is zero, the base is set according to the following rules: if the string starts with '0b' or '0B' the base is set to 2; if the string starts with '0x' or '0X' the base is set to 16; otherwise the base is set to 10. The following exponent symbols can be used: '@' - can be used for any base; 'e' or 'E' - can be used only with bases <= 10; 'p' or 'P' - can be used to introduce binary exponents with hexadecimal or binary strings. See the MPFR library documentation for more details. See also 'Rmpfr_inp_str' (below). Because of the special significance of the '@' symbol in perl, make sure you assign to strings using single quotes, not double quotes, when using '@' as the exponent marker. If you must use double quotes (which is hard to believe) then you need to escape the '@'. ie the following two assignments are equivalent: Rmpfr_set_str($rop, '.1234@-5', 10, GMP_RNDN); Rmpfr_set_str($rop, ".1234\@-5", 10, GMP_RNDN); But the following assignment won't do what you want: Rmpfr_set_str($rop, ".1234@-5", 10, GMP_RNDN); Rmpfr_strtofr($rop, $str, $base, $rnd); Read a floating point number from a string $str in base $base, rounded in the direction $rnd. If successful, the result is stored in $rop. If $str doesn't start with a valid number then $rop is set to zero. Parsing follows the standard C `strtod' function with some extensions. Case is ignored. After optional leading whitespace, one has a subject sequence consisting of an optional sign (`+' or `-'), and either numeric data or special data. The subject sequence is defined as the longest initial subsequence of the input string, starting with the first non-whitespace character, that is of the expected form. The form of numeric data is a non-empty sequence of significand digits with an optional decimal point, and an optional exponent consisting of an exponent prefix followed by an optional sign and a non-empty sequence of decimal digits. A significand digit is either a decimal digit or a Latin letter (62 possible characters), with `a' = 10, `b' = 11, ..., `z' = 36; its value must be strictly less than the base. The decimal point can be either the one defined by the current locale or the period (the first one is accepted for consistency with the C standard and the practice, the second one is accepted to allow the programmer to provide MPFR numbers from strings in a way that does not depend on the current locale). The exponent prefix can be `e' or `E' for bases up to 10, or `@' in any base; it indicates a multiplication by a power of the base. In bases 2 and 16, the exponent prefix can also be `p' or `P', in which case it introduces a binary exponent: it indicates a multiplication by a power of 2 (there is a difference only for base 16). The value of an exponent is always written in base 10. In base 2, the significand can start with `0b' or `0B', and in base 16, it can start with `0x' or `0X'. If the argument $base is 0, then the base is automatically detected as follows. If the significand starts with `0b' or `0B', base 2 is assumed. If the significand starts with `0x' or `0X', base 16 is assumed. Otherwise base 10 is assumed. Other allowable values for $base are 2 to 36 (2 to 62 if Math::MPFR has been built against mpfr-3.0.0 or later). Note: The exponent must contain at least a digit. Otherwise the possible exponent prefix and sign are not part of the number (which ends with the significand). Similarly, if `0b', `0B', `0x' or `0X' is not followed by a binary/hexadecimal digit, then the subject sequence stops at the character `0'. Special data (for infinities and NaN) can be `@inf@' or `@nan@(n-char-sequence)', and if BASE <= 16, it can also be `infinity', `inf', `nan' or `nan(n-char-sequence)', all case insensitive. A `n-char-sequence' is a non-empty string containing only digits, Latin letters and the underscore (0, 1, 2, ..., 9, a, b, ..., z, A, B, ..., Z, _). Note: one has an optional sign for all data, even NaN. The function returns a usual ternary value. Rmpfr_set_str_binary($rop, $str); Removed in Math-MPFR-3.30. Should have been removed long ago. Set $rop to the value of the binary number in $str, which has to be of the form +/-xxxx.xxxxxxEyy. The exponent is read in decimal, but is interpreted as the power of two to be multiplied by the mantissa. The mantissa length of $str has to be less or equal to the precision of $rop, otherwise an error occurs. If $str starts with `N', it is interpreted as NaN (Not-a-Number); if it starts with `I' after the sign, it is interpreted as infinity, with the corresponding sign. Rmpfr_set_inf($rop, $si); Rmpfr_set_nan($rop); Rmpfr_set_zero($rop, $si); # mpfr-3.0.0 and later only. Set the variable $rop to infinity or NaN (Not-a-Number) or zero respectively. In 'mpfr_set_inf' and 'mpfr_set_zero', the sign of $rop is positive if 2nd arg >= 0. Else the sign is negative. Rmpfr_swap($op1, $op2); Swap the values $op1 and $op2 efficiently. Warning: the precisions are exchanged too; in case the precisions are different, `mpfr_swap' is thus not equivalent to three `mpfr_set' calls using a third auxiliary variable. ################################################ COMBINED INITIALIZATION AND ASSIGNMENT NOTE: Do NOT use these functions if $rop has already been initialised. Use the Rmpfr_set* functions in the section 'ASSIGNMENT' (above). First read the section 'MEMORY MANAGEMENT' (above). $rop = Math::MPFR->new($arg); $rop = Math::MPFR::new($arg); $rop = new Math::MPFR($arg); Returns a Math::MPFR object with the value of $arg, rounded in the default rounding direction, with default precision. $arg can be either a number (signed integer, unsigned integer, signed fraction or unsigned fraction), a string that represents a numeric value, or an object (of type Math::GMPf, Math::GMPq, Math::GMPz, orMath::GMP) If $arg is a string, an optional additional argument that specifies the base of the number can be supplied to new(). Legal values for base are 0 and 2 to 36 (2 to 62 if Math::MPFR has been built against mpfr-3.0.0 or later). If $arg is a string and no additional argument is supplied, an attempt is made to deduce base. See 'Rmpfr_set_str' above for an explanation of how that deduction is attempted. For finer grained control, use one of the 'Rmpfr_init_set_*' functions documented immediately below. Note that these functions return a list of 2 values. ($rop, $si) = Rmpfr_init_set($op, $rnd); ($rop, $si) = Rmpfr_init_set_nobless($op, $rnd); ($rop, $si) = Rmpfr_init_set_ui($ui, $rnd); ($rop, $si) = Rmpfr_init_set_ui_nobless($ui, $rnd); ($rop, $si) = Rmpfr_init_set_si($si, $rnd); ($rop, $si) = Rmpfr_init_set_si_nobless($si, $rnd); ($rop, $si) = Rmpfr_init_set_d($double, $rnd); ($rop, $si) = Rmpfr_init_set_d_nobless($double, $rnd); ($rop, $si) = Rmpfr_init_set_ld($double, $rnd); ($rop, $si) = Rmpfr_init_set_ld_nobless($double, $rnd); ($rop, $si) = Rmpfr_init_set_f($f, $rnd);# $f is a mpf object ($rop, $si) = Rmpfr_init_set_f_nobless($f, $rnd);# $f is a mpf object ($rop, $si) = Rmpfr_init_set_z($z, $rnd);# $z is a mpz object ($rop, $si) = Rmpfr_init_set_z_nobless($z, $rnd);# $z is a mpz object ($rop, $si) = Rmpfr_init_set_q($q, $rnd);# $q is a mpq object ($rop, $si) = Rmpfr_init_set_q_nobless($q, $rnd);# $q is a mpq object Initialize $rop and set its value from the 1st arg, rounded to direction $rnd. The precision of $rop will be taken from the active default precision, as set by `Rmpfr_set_default_prec'. If $rop = 1st arg, $si is zero. If $rop > 1st arg, $si is positive. If $rop < 1st arg, $si is negative. ($rop, $si) = Rmpfr_init_set_str($str, $base, $rnd); ($rop, $si) = Rmpfr_init_set_str_nobless($str, $base, $rnd); Initialize $rop and set its value from $str in base $base, rounded to direction $rnd. If $str was a valid number, then $si will be set to 0. Else it will be set to -1. If $si is -1 : 1) the non-numeric flag (which was initalised to 0) will be incremented. You can query/clear/reset the value of the flag with (resp.) nnumflag()/clear_nnum()/set_nnum() - all of which are documented below (in "MISCELLANEOUS"); 2) A warning will be emitted if $Math::MPFR::NNW is set to 1 (default is 0). See `Rmpfr_set_str' (above) and 'Rmpfr_inp_str' (below). ########## CONVERSION $str = Rmpfr_get_str($op, $base, $digits, $rnd); Returns a string of the form, eg, '8.3456712@2' which means '834.56712'. The third argument to Rmpfr_get_str() specifies the number of digits required to be output in the mantissa. (Trailing zeroes are removed.) If $digits is 0, the number of digits of the mantissa is chosen large enough so that re-reading the printed value with the same precision, assuming both output and input use rounding to nearest, will recover the original value of $op. ($str, $si) = Rmpfr_deref2($op, $base, $digits, $rnd); Returns the mantissa to $str (as a string of digits, prefixed with a minus sign if $op is negative), and returns the exponent to $si. There's an implicit decimal point to the left of the first digit in $str. The third argument to Rmpfr_deref2() specifies the number of digits required to be output in the mantissa. If $digits is 0, the number of digits of the mantissa is chosen large enough so that re-reading the printed value with the same precision, assuming both output and input use rounding to nearest, will recover the original value of $op. $str = Rmpfr_integer_string($op, $base, $rnd); Returns the truncated integer value of $op as a string. (No exponent is returned). For example, if $op contains the value 2.3145679e2, $str will be set to "231". (This function is mainly to provide a simple means of getting 'sj' and 'uj' values on a 64-bit perl where the MPFR library does not support mpfr_get_uj and mpfr_get_sj functions - which may happen, for example, with libraries built with Microsoft Compilers.) $bool = Rmpfr_fits_ushort_p($op, $rnd); # fits in unsigned short $bool = Rmpfr_fits_sshort_p($op, $rnd); # fits in signed short $bool = Rmpfr_fits_uint_p($op, $rnd); # fits in unsigned int $bool = Rmpfr_fits_sint_p($op, $rnd); # fits in signed int $bool = Rmpfr_fits_ulong_p($op, $rnd); # fits in unsigned long $bool = Rmpfr_fits_slong_p($op, $rnd); # fits in signed long $bool = Rmpfr_fits_uintmax_p($op, $rnd); # fits in uintmax_t $bool = Rmpfr_fits_intmax_p($op, $rnd); # fits in intmax_t $bool = Rmpfr_fits_IV_p($op, $rnd); # fits in perl IV $bool = Rmpfr_fits_UV_p($op, $rnd); # fits in perl UV Return non-zero if $op would fit in the respective data type, when rounded to an integer in the direction $rnd. $ui = Rmpfr_get_ui($op, $rnd); $si = Rmpfr_get_si($op, $rnd); $sj = Rmpfr_get_sj($op, $rnd); # 64 bit builds only $uj = Rmpfr_get_uj($op, $rnd); # 64 bit builds only $uv = Rmpfr_get_UV($op, $rnd); # 32 and 64 bit $iv = Rmpfr_get_IV($op, $rnd); # 32 and 64 bit Convert $op to an 'unsigned long long', a 'signed long', a 'signed long long', an `unsigned long long', a 'UV', or an 'IV' - after rounding it with respect to $rnd. If $op is NaN, the result is undefined. If $op is too big for the return type, it returns the maximum or the minimum of the corresponding C type, depending on the direction of the overflow. The flag erange is then also set. $double = Rmpfr_get_d($op, $rnd); $ld = Rmpfr_get_ld($op, $rnd); $f128 = Rmpfr_get_float128($op, $rnd); # nvtype must be __float128 # mpfr-3.2.0 or later $nv = Rmpfr_get_NV($op, $rnd); # double/long double/__float128 $float = Rmpfr_get_flt($op, $rnd); # mpfr-3.0.0 and later. Rmpfr_get_LD($LD, $op, $rnd); # $LD is a Math::LongDouble object. Rmpfr_get_DECIMAL64($d64, $op, $rnd); # mpfr-3.1.1 and later. # $d64 is a Math::Decimal64 # object. Rmpfr_get_FLOAT128($F128, $op, $rnd); # mpfr-3.2.0 and later. # $F128 is a Math::Float128 # object. Convert $op to a 'double' a 'long double' an 'NV', a float, a __float128, a Math::LongDouble object, a Math::Decimal64 object, or a Math::Float128 object using the rounding mode $rnd. $double = Rmpfr_get_d1($op); Convert $op to a double, using the default MPFR rounding mode (see function `mpfr_set_default_rounding_mode'). $si = Rmpfr_get_z_exp($z, $op); # $z is a mpz object $si = Rmpfr_get_z_2exp($z, $op); # $z is a mpz object (Identical functions. Use either - 'get_z_exp' might one day be removed.) Puts the mantissa of $rop into $z, and returns the exponent $si such that $rop == $z * (2 ** $ui). $si = Rmpfr_get_z($z, $op, $rnd); # $z is a mpz object. Convert $op to an mpz object ($z), after rounding it with respect to RND. If built against mpfr-3.0.0 or later, return the usual ternary value. (The function returns undef when using mpfr-2.x.x.) If $op is NaN or Inf, the result is undefined. $si = Rmpfr_get_f ($f, $op, $rnd); # $f is a Math::GMPf object. Convert $op to a `mpf_t', after rounding it with respect to $rnd. When built against mpfr-3.0.0 or later, this function returns the usual ternary value. (If $op is NaN or Inf, then the erange flag will be set.) When built against earlier versions of mpfr, return zero iff no error occurred.In particular a non-zero value is returned if $op is NaN or Inf. which do not exist in `mpf'. Rmpfr_get_q ($q, $op); # $q is a Math::GMPq object. Convert $op to a rational value. $q will be set to the exact value contained in $op - hence no need for a rounding argument. If $op is NaN or Inf, then $q is set to zero and the erange flag will be set. $d = Rmpfr_get_d_2exp ($exp, $op, $rnd); # $d is NV (double) $d = Rmpfr_get_ld_2exp ($exp, $op, $rnd); # $d is NV (long double) Set $exp and $d such that 0.5<=abs($d)<1 and $d times 2 raised to $exp equals $op rounded to double (resp. long double) precision, using the given rounding mode. If $op is zero, then a zero of the same sign (or an unsigned zero, if the implementation does not have signed zeros) is returned, and $exp is set to 0. If $op is NaN or an infinity, then the corresponding double precision (resp. long-double precision) value is returned, and $exp is undefined. $si1 = Rmpfr_frexp($si2, $rop, $op, $rnd); # mpfr-3.1.0 and later only Set $si and $rop such that 0.5<=abs($rop)<1 and $rop * (2 ** $exp) equals $op rounded to the precision of $rop, using the given rounding mode. If $op is zero, then $rop is set to zero (of the same sign) and $exp is set to 0. If $op is NaN or an infinity, then $rop is set to the same value and the value of $exp is meaningless (and should be ignored). ########## ARITHMETIC $si = Rmpfr_add($rop, $op1, $op2, $rnd); $si = Rmpfr_add_ui($rop, $op, $ui, $rnd); $si = Rmpfr_add_si($rop, $op, $si1, $rnd); $si = Rmpfr_add_d($rop, $op, $double, $rnd); $si = Rmpfr_add_z($rop, $op, $z, $rnd); # $z is a mpz object. $si = Rmpfr_add_q($rop, $op, $q, $rnd); # $q is a mpq object. Set $rop to 2nd arg + 3rd arg rounded in the direction $rnd. The return value is zero if $rop is exactly 2nd arg + 3rd arg, positive if $rop is larger than 2nd arg + 3rd arg, and negative if $rop is smaller than 2nd arg + 3rd arg. $si = Rmpfr_sum($rop, \@ops, scalar(@ops), $rnd); @ops is an array consisting entirely of Math::MPFR objects. Set $rop to the sum of all members of @ops, rounded in the direction $rnd. $si is zero when the computed value is the exact value, and non-zero when this cannot be guaranteed, without giving the direction of the error as the other functions do. $si = Rmpfr_sub($rop, $op1, $op2, $rnd); $si = Rmpfr_sub_ui($rop, $op, $ui, $rnd); $si = Rmpfr_sub_z($rop, $op, $z, $rnd); # $z is a mpz object. $si = Rmpfr_z_sub($rop, $z, $op, $rnd); # mpfr-3.1.0 and later only $si = Rmpfr_sub_q($rop, $op, $q, $rnd); # $q is a mpq object. $si = Rmpfr_ui_sub($rop, $ui, $op, $rnd); $si = Rmpfr_si_sub($rop, $si1, $op, $rnd); $si = Rmpfr_sub_si($rop, $op, $si1, $rnd); $si = Rmpfr_sub_d($rop, $op, $double, $rnd); $si = Rmpfr_d_sub($rop, $double, $op, $rnd); Set $rop to 2nd arg - 3rd arg rounded in the direction $rnd. The return value is zero if $rop is exactly 2nd arg - 3rd arg, positive if $rop is larger than 2nd arg - 3rd arg, and negative if $rop is smaller than 2nd arg - 3rd arg. $si = Rmpfr_mul($rop, $op1, $op2, $rnd); $si = Rmpfr_mul_ui($rop, $op, $ui, $rnd); $si = Rmpfr_mul_si($rop, $op, $si1, $rnd); $si = Rmpfr_mul_d($rop, $op, $double, $rnd); $si = Rmpfr_mul_z($rop, $op, $z, $rnd); # $z is a mpz object. $si = Rmpfr_mul_q($rop, $op, $q, $rnd); # $q is a mpq object. Set $rop to 2nd arg * 3rd arg rounded in the direction $rnd. Return 0 if the result is exact, a positive value if $rop is greater than 2nd arg times 3rd arg, a negative value otherwise. $si = Rmpfr_div($rop, $op1, $op2, $rnd); $si = Rmpfr_div_ui($rop, $op, $ui, $rnd); $si = Rmpfr_ui_div($rop, $ui, $op, $rnd); $si = Rmpfr_div_si($rop, $op, $si1, $rnd); $si = Rmpfr_si_div($rop, $si1, $op, $rnd); $si = Rmpfr_div_d($rop, $op, $double, $rnd); $si = Rmpfr_d_div($rop, $double, $op, $rnd); $si = Rmpfr_div_z($rop, $op, $z, $rnd); # $z is a mpz object. $si = Rmpfr_div_q($rop, $op, $q, $rnd); # $q is a mpq object. Set $rop to 2nd arg / 3rd arg rounded in the direction $rnd. These functions return 0 if the division is exact, a positive value when $rop is larger than 2nd arg divided by 3rd arg, and a negative value otherwise. $si = Rmpfr_sqr($rop, $op, $rnd); Set $rop to the square of $op, rounded in direction $rnd. $si = Rmpfr_sqrt($rop, $op, $rnd); $si = Rmpfr_sqrt_ui($rop, $ui, $rnd); Set $rop to the square root of the 2nd arg rounded in the direction $rnd. Set $rop to NaN if 2nd arg is negative. Return 0 if the operation is exact, a non-zero value otherwise. $si = Rmpfr_rec_sqrt($rop, $op, $rnd); Set $rop to the reciprocal square root of $op rounded in the direction $rnd. Set $rop to +Inf if $op is 0, and 0 if $op is +Inf. Set $rop to NaN if $op is negative. $si = Rmpfr_cbrt($rop, $op, $rnd); Set $rop to the cubic root (defined over the real numbers) of $op, rounded in the direction $rnd. $si = Rmpfr_root($rop, $op, $ui $rnd); Set $rop to the $ui'th root of $op, rounded in the direction $rnd. Return 0 if the operation is exact, a non-zero value otherwise. $si = Rmpfr_pow_ui($rop, $op, $ui, $rnd); $si = Rmpfr_pow_si($rop, $op, $si, $rnd); $si = Rmpfr_ui_pow_ui($rop, $ui, $ui, $rnd); $si = Rmpfr_ui_pow($rop, $ui, $op, $rnd); $si = Rmpfr_pow($rop, $op1, $op2, $rnd); $si = Rmpfr_pow_z($rop, $op1, $z, $rnd); # $z is a mpz object Set $rop to 2nd arg raised to 3rd arg, rounded to the directio $rnd with the precision of $rop. Return zero iff the result is exact, a positive value when the result is greater than 2nd arg to the power 3rd arg, and a negative value when it is smaller. See the MPFR documentation for documentation regarding special cases. $si = Rmpfr_neg($rop, $op, $rnd); Set $rop to -$op rounded in the direction $rnd. Just changes the sign if $rop and $op are the same variable. $si = Rmpfr_abs($rop, $op, $rnd); Set $rop to the absolute value of $op, rounded in the direction $rnd. Return 0 if the result is exact, a positive value if $rop is larger than the absolute value of $op, and a negative value otherwise. $si = Rmpfr_dim($rop, $op1, $op2, $rnd); Set $rop to the positive difference of $op1 and $op2, i.e., $op1 - $op2 rounded in the direction $rnd if $op1 > $op2, and +0 otherwise. $rop is set to NaN when $op1 or $op2 is NaN. $si = Rmpfr_mul_2exp($rop, $op, $ui, $rnd); $si = Rmpfr_mul_2ui($rop, $op, $ui, $rnd); $si = Rmpfr_mul_2si($rop, $op, $si, $rnd); Set $rop to 2nd arg times 2 raised to 3rd arg rounded to the direction $rnd. Just increases the exponent by 3rd arg when $rop and 2nd arg are identical. Return zero when $rop = 2nd arg, a positive value when $rop > 2nd arg, and a negative value when $rop < 2nd arg. Note: The `Rmpfr_mul_2exp' function is defined for compatibility reasons; you should use `Rmpfr_mul_2ui' (or `Rmpfr_mul_2si') instead. $si = Rmpfr_div_2exp($rop, $op, $ui, $rnd); $si = Rmpfr_div_2ui($rop, $op, $ui, $rnd); $si = Rmpfr_div_2si($rop, $op, $si, $rnd); Set $rop to 2nd arg divided by 2 raised to 3rd arg rounded to the direction $rnd. Just decreases the exponent by 3rd arg when $rop and 2nd arg are identical. Return zero when $rop = 2nd arg, a positive value when $rop > 2nd arg, and a negative value when $rop < 2nd arg. Note: The `Rmpfr_div_2exp' function is defined for compatibility reasons; you should use `Rmpfr_div_2ui' (or `Rmpfr_div_2si') instead. ########## COMPARISON $si = Rmpfr_cmp($op1, $op2); $si = Rmpfr_cmpabs($op1, $op2); $si = Rmpfr_cmp_ui($op, $ui); $si = Rmpfr_cmp_si($op, $si); $si = Rmpfr_cmp_d($op, $double); $si = Rmpfr_cmp_ld($op, $ld); # long double $si = Rmpfr_cmp_z($op, $z); # $z is a mpz object $si = Rmpfr_cmp_q($op, $q); # $q is a mpq object $si = Rmpfr_cmp_f($op, $f); # $f is a mpf object Compare 1st and 2nd args. In the case of 'Rmpfr_cmpabs()' compare the absolute values of the 2 args. Return a positive value if 1st arg > 2nd arg, zero if 1st arg = 2nd arg, and a negative value if 1st arg < 2nd arg. Both args are considered to their full own precision, which may differ. In case 1st and 2nd args are of same sign but different, the absolute value returned is one plus the absolute difference of their exponents. If one of the operands is NaN (Not-a-Number), return zero and set the erange flag. $si = Rmpfr_cmp_ui_2exp($op, $ui, $si); $si = Rmpfr_cmp_si_2exp($op, $si, $si); Compare 1st arg and 2nd arg multiplied by two to the power 3rd arg. $bool = Rmpfr_eq($op1, $op2, $ui); The mpfr library function mpfr_eq may change in future releases of the mpfr library (post 2.4.0). If that happens, the change will also be relected in Rmpfr_eq. Return non-zero if the first $ui bits of $op1 and $op2 are equal, zero otherwise. I.e., tests if $op1 and $op2 are approximately equal. $bool = Rmpfr_nan_p($op); Return non-zero if $op is Not-a-Number (NaN), zero otherwise. $bool = Rmpfr_inf_p($op); Return non-zero if $op is plus or minus infinity, zero otherwise. $bool = Rmpfr_number_p($op); Return non-zero if $op is an ordinary number, i.e. neither Not-a-Number nor plus or minus infinity. $bool = Rmpfr_zero_p($op); Return non-zero if $op is zero. Else return 0. $bool = Rmpfr_regular_p($op); # mpfr-3.0.0 and later only Return non-zero if $op is a regular number (i.e. neither NaN, nor an infinity nor zero). Return zero otherwise. Rmpfr_reldiff($rop, $op1, $op2, $rnd); Compute the relative difference between $op1 and $op2 and store the result in $rop. This function does not guarantee the exact rounding on the relative difference; it just computes abs($op1-$op2)/$op1, using the rounding mode $rnd for all operations. $si = Rmpfr_sgn($op); Return a positive value if op > 0, zero if $op = 0, and a negative value if $op < 0. Its result is not specified when $op is NaN (Not-a-Number). $bool = Rmpfr_greater_p($op1, $op2); Return non-zero if $op1 > $op2, zero otherwise. $bool = Rmpfr_greaterequal_p($op1, $op2); Return non-zero if $op1 >= $op2, zero otherwise. $bool = Rmpfr_less_p($op1, $op2); Return non-zero if $op1 < $op2, zero otherwise. $bool = Rmpfr_lessequal_p($op1, $op2); Return non-zero if $op1 <= $op2, zero otherwise. $bool = Rmpfr_lessgreater_p($op1, $op2); Return non-zero if $op1 < $op2 or $op1 > $op2 (i.e. neither $op1, nor $op2 is NaN, and $op1 <> $op2), zero otherwise (i.e. $op1 and/or $op2 are NaN, or $op1 = $op2). $bool = Rmpfr_equal_p($op1, $op2); Return non-zero if $op1 = $op2, zero otherwise (i.e. $op1 and/or $op2 are NaN, or $op1 <> $op2). $bool = Rmpfr_unordered_p($op1, $op2); Return non-zero if $op1 or $op2 is a NaN (i.e. they cannot be compared), zero otherwise. ####### SPECIAL $si = Rmpfr_log($rop, $op, $rnd); $si = Rmpfr_log2($rop, $op, $rnd); $si = Rmpfr_log10($rop, $op, $rnd); Set $rop to the natural logarithm of $op, log2($op) or log10($op), respectively, rounded in the direction rnd. $si = Rmpfr_exp($rop, $op, $rnd); $si = Rmpfr_exp2($rop, $op, $rnd); $si = Rmpfr_exp10($rop, $op, $rnd); Set rop to the exponential of op, to 2 power of op or to 10 power of op, respectively, rounded in the direction rnd. $si = Rmpfr_sin($rop $op, $rnd); $si = Rmpfr_cos($rop, $op, $rnd); $si = Rmpfr_tan($rop, $op, $rnd); Set $rop to the sine/cosine/tangent respectively of $op, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact (this occurs in fact only when $op is 0 i.e. the sine is 0, the cosine is 1, and the tangent is 0). Return a negative value iff the result is less than the actual value. Return a positive result iff the return is greater than the actual value. $si = Rmpfr_sin_cos($rop1, $rop2, $op, $rnd); Set simultaneously $rop1 to the sine of $op and $rop2 to the cosine of $op, rounded to the direction $rnd with their corresponding precisions. Return 0 iff both results are exact. $si = Rmpfr_sinh_cosh($rop1, $rop2, $op, $rnd); Set simultaneously $rop1 to the hyperbolic sine of $op and $rop2 to the hyperbolic cosine of $op, rounded in the direction $rnd with the corresponding precision of $rop1 and $rop2 which must be different variables. Return 0 iff both results are exact. $si = Rmpfr_acos($rop, $op, $rnd); $si = Rmpfr_asin($rop, $op, $rnd); $si = Rmpfr_atan($rop, $op, $rnd); Set $rop to the arc-cosine, arc-sine or arc-tangent of $op, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact. Return a negative value iff the result is less than the actual value. Return a positive result iff the return is greater than the actual value. $si = Rmpfr_atan2($rop, $op1, $op2, $rnd); Set $rop to the tangent of $op1/$op2, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact. Return a negative value iff the result is less than the actual value. Return a positive result iff the return is greater than the actual value. See the MPFR documentation for details regarding special cases. $si = Rmpfr_cosh($rop, $op, $rnd); $si = Rmpfr_sinh($rop, $op, $rnd); $si = Rmpfr_tanh($rop, $op, $rnd); Set $rop to the hyperbolic cosine/hyperbolic sine/hyperbolic tangent respectively of $op, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact (this occurs in fact only when $op is 0 i.e. the result is 1). Return a negative value iff the result is less than the actual value. Return a positive result iff the return is greater than the actual value. $si = Rmpfr_acosh($rop, $op, $rnd); $si = Rmpfr_asinh($rop, $op, $rnd); $si = Rmpfr_atanh($rop, $op, $rnd); Set $rop to the inverse hyperbolic cosine, sine or tangent of $op, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact. $si = Rmpfr_sec ($rop, $op, $rnd); $si = Rmpfr_csc ($rop, $op, $rnd); $si = Rmpfr_cot ($rop, $op, $rnd); Set $rop to the secant of $op, cosecant of $op, cotangent of $op, rounded in the direction RND. Return 0 iff the result is exact. Return a negative value iff the result is less than the actual value. Return a positive result iff the return is greater than the actual value. $si = Rmpfr_sech ($rop, $op, $rnd); $si = Rmpfr_csch ($rop, $op, $rnd); $si = Rmpfr_coth ($rop, $op, $rnd); Set $rop to the hyperbolic secant of $op, cosecant of $op, cotangent of $op, rounded in the direction RND. Return 0 iff the result is exact. Return a negative value iff the result is less than the actual value. Return a positive result iff the return is greater than the actual value. $bool = Rmpfr_fac_ui($rop, $ui, $rnd); Set $rop to the factorial of $ui, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact. $bool = Rmpfr_log1p($rop, $op, $rnd); Set $rop to the logarithm of one plus $op, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact (this occurs in fact only when $op is 0 i.e. the result is 0). $bool = Rmpfr_expm1($rop, $op, $rnd); Set $rop to the exponential of $op minus one, rounded to the direction $rnd with the precision of $rop. Return 0 iff the result is exact (this occurs in fact only when $op is 0 i.e the result is 0). $si = Rmpfr_fma($rop, $op1, $op2, $op3, $rnd); Set $rop to $op1 * $op2 + $op3, rounded to the direction $rnd. $si = Rmpfr_fms($rop, $op1, $op2, $op3, $rnd); Set $rop to $op1 * $op2 - $op3, rounded to the direction $rnd. $si = Rmpfr_agm($rop, $op1, $op2, $rnd); Set $rop to the arithmetic-geometric mean of $op1 and $op2, rounded to the direction $rnd with the precision of $rop. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_hypot ($rop, $op1, $op2, $rnd); Set $rop to the Euclidean norm of $op1 and $op2, i.e. the square root of the sum of the squares of $op1 and $op2, rounded in the direction $rnd. Special values are currently handled as described in Section F.9.4.3 of the ISO C99 standard, for the hypot function (note this may change in future versions): If $op1 or $op2 is an infinity, then plus infinity is returned in $rop, even if the other number is NaN. $si = Rmpfr_ai($rop, $op, $rnd); # mpfr-3.0.0 and later only Set $rop to the value of the Airy function Ai on $op, rounded in the direction $rnd. When $op is NaN, $rop is always set to NaN. When $op is +Inf or -Inf, $rop is +0. The current implementation is not intended to be used with large arguments. It works with $op typically smaller than 500. For larger arguments, other methods should be used and will be implemented soon. $si = Rmpfr_const_log2($rop, $rnd); Set $rop to the logarithm of 2 rounded to the direction $rnd with the precision of $rop. This function stores the computed value to avoid another calculation if a lower or equal precision is requested. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_const_pi($rop, $rnd); Set $rop to the value of Pi rounded to the direction $rnd with the precision of $rop. This function uses the Borwein, Borwein, Plouffe formula which directly gives the expansion of Pi in base 16. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_const_euler($rop, $rnd); Set $rop to the value of Euler's constant 0.577... rounded to the direction $rnd with the precision of $rop. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_const_catalan($rop, $rnd); Set $rop to the value of Catalan's constant 0.915... rounded to the direction $rnd with the precision of $rop. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. Rmpfr_free_cache(); Free the cache used by the functions computing constants if needed (currently `mpfr_const_log2', `mpfr_const_pi' and `mpfr_const_euler'). $si = Rmpfr_gamma($rop, $op, $rnd); $si = Rmpfr_lngamma($rop, $op, $rnd); Set $rop to the value of the Gamma function on $op (and, respectively, its natural logarithm) rounded to the direction $rnd. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. ($signp, $si) = Rmpfr_lgamma ($rop, $op, $rnd); Set $rop to the value of the logarithm of the absolute value of the Gamma function on $op, rounded in the direction $rnd. The sign (1 or -1) of Gamma($op) is returned in $signp. When $op is an infinity or a non-positive integer, +Inf is returned. When $op is NaN, -Inf or a negative integer, $signp is undefined, and when $op is 0, $signp is the sign of the zero. $si = Rmpfr_digamma ($rop, $op, $rnd); # mpfr-3.0.0 and later only Set $rop to the value of the Digamma (sometimes also called Psi) function on $op, rounded in the direction $rnd. When $op is a negative integer, set $rop to NaN. $si = Rmpfr_zeta($rop, $op, $rnd); $si = Rmpfr_zeta_ui($rop, $ul, $rnd); Set $rop to the value of the Riemann Zeta function on 2nd arg, rounded to the direction $rnd. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_erf($rop, $op, $rnd); Set $rop to the value of the error function on $op, rounded to the direction $rnd. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_erfc($rop, $op, $rnd); Set $rop to the complementary error function on $op, rounded to the direction $rnd. Return zero if $rop is exact, a positive value if $rop is larger than the exact value, or a negative value if $rop is less than the exact value. $si = Rmpfr_j0 ($rop, $op, $rnd); $si = Rmpfr_j1 ($rop, $op, $rnd); $si = Rmpfr_jn ($rop, $si2, $op, $rnd); Set $rop to the value of the first order Bessel function of order 0, 1 and $si2 on $op, rounded in the direction $rnd. When $op is NaN, $rop is always set to NaN. When $op is plus or minus Infinity, $rop is set to +0. When $op is zero, and $si2 is not zero, $rop is +0 or -0 depending on the parity and sign of $si2, and the sign of $op. $si = Rmpfr_y0 ($rop, $op, $rnd); $si = Rmpfr_y1 ($rop, $op, $rnd); $si = Rmpfr_yn ($rop, $si2, $op, $rnd); Set $rop to the value of the second order Bessel function of order 0, 1 and $si2 on $op, rounded in the direction $rnd. When $op is NaN or negative, $rop is always set to NaN. When $op is +Inf, $rop is +0. When $op is zero, $rop is +Inf or -Inf depending on the parity and sign of $si2. $si = Rmpfr_eint ($rop, $op, $rnd) Set $rop to the exponential integral of $op, rounded in the direction $rnd. See the MPFR documentation for details. $si = Rmpfr_li2 ($rop, $op, $rnd); Set $rop to real part of the dilogarithm of $op, rounded in the direction $rnd. The dilogarithm function is defined here as the integral of -log(1-t)/t from 0 to x. ############# I-O FUNCTIONS $ui = Rmpfr_out_str([$prefix,] $op, $base, $digits, $round [, $suffix]); BEST TO USE TRmpfr_out_str INSTEAD Output $op to STDOUT, as a string of digits in base $base, rounded in direction $round. The base may vary from 2 to 36 (2 to 62 if Math::MPFR has been built against mpfr-3.0.0 or later). Print $digits significant digits exactly, or if $digits is 0, enough digits so that $op can be read back exactly (see Rmpfr_get_str). In addition to the significant digits, a decimal point at the right of the first digit and a trailing exponent in base 10, in the form `eNNN', are printed If $base is greater than 10, `@' will be used instead of `e' as exponent delimiter. The optional arguments, $prefix and $suffix, are strings that will be prepended/appended to the mpfr_out_str output. Return the number of bytes written (not counting those contained in $suffix and $prefix), or if an error occurred, return 0. (Note that none, one or both of $prefix and $suffix can be supplied.) $ui = TRmpfr_out_str([$prefix,] $stream, $base, $digits, $op, $round [, $suffix]); As for Rmpfr_out_str, except that there's the capability to print to somewhere other than STDOUT. Note that the order of the args is different (to match the order of the mpfr_out_str args). To print to STDERR: TRmpfr_out_str(*stderr, $base, $digits, $op, $round); To print to an open filehandle (let's call it FH): TRmpfr_out_str(\*FH, $base, $digits, $op, $round); $ui = Rmpfr_inp_str($rop, $base, $round); BEST TO USE TRmpfr_inp_str INSTEAD. Input a string in base $base from STDIN, rounded in direction $round, and put the read float in $rop. The string is of the form `M@N' or, if the base is 10 or less, alternatively `MeN' or `MEN', or, if the base is 16, alternatively `MpB' or `MPB'. `M' is the mantissa in the specified base, `N' is the exponent written in decimal for the specified base, and in base 16, `B' is the binary exponent written in decimal (i.e. it indicates the power of 2 by which the mantissa is to be scaled). The argument $base may be in the range 2 to 36 (2 to 62 if Math::MPFR has been built against mpfr-3.0.0 or later). Special values can be read as follows (the case does not matter): `@NaN@', `@Inf@', `+@Inf@' and `-@Inf@', possibly followed by other characters; if the base is smaller or equal to 16, the following strings are accepted too: `NaN', `Inf', `+Inf' and `-Inf'. Return the number of bytes read, or if non-numeric characters were encountered in the input, return 0. If 0 is returned: 1) the non-numeric flag (which was initalised to 0) will be incremented. You can query/clear/reset the value of the flag with (resp.) nnumflag()/clear_nnum()/set_nnum() - all of which are documented below; 2) A warning will be emitted if $Math::MPFR::NNW is set to 1 (default is 0). $ui = TRmpfr_inp_str($rop, $stream, $base, $round); As for Rmpfr_inp_str, except that there's the capability to read from somewhere other than STDIN. To read from STDIN: TRmpfr_inp_str($rop, *stdin, $base, $round); To read from an open filehandle (let's call it FH): TRmpfr_inp_str($rop, \*FH, $base, $round); Rmpfr_print_binary($op); Removed in Math-MPFR-3.30. Should have been removed long ago. Output $op on stdout in raw binary format (the exponent is in decimal, yet). Rmpfr_dump($op); Output "$op\n" on stdout in base 2. As with 'Rmpfr_print_binary' the exponent is in base 10. ############# MISCELLANEOUS $MPFR_version = Rmpfr_get_version(); Returns the version of the MPFR library (eg 2.1.0) being used by Math::MPFR. $GMP_version = Math::MPFR::gmp_v(); Returns the version of the gmp library (eg. 4.1.3) being used by the mpfr library that's being used by Math::MPFR. The function is not exportable. $ui = MPFR_VERSION; An integer whose value is dependent upon the 'major', 'minor' and 'patchlevel' values of the MPFR library against which Math::MPFR was built. This value is from the mpfr.h that was in use when the compilation of Math::MPFR took place. $ui = MPFR_VERSION_MAJOR; The 'x' in the 'x.y.z' of the MPFR library version. This value is from the mpfr.h that was in use when the compilation of Math::MPFR took place. $ui = MPFR_VERSION_MINOR; The 'y' in the 'x.y.z' of the MPFR library version. This value is from the mpfr.h that was in use when the compilation of Math::MPFR took place. $ui = MPFR_VERSION_PATCHLEVEL; The 'z' in the 'x.y.z' of the MPFR library version. This value is from the mpfr.h that was in use when the compilation of Math::MPFR took place. $string = MPFR_VERSION_STRING; $string is set to the version of the MPFR library (eg 2.1.0) against which Math::MPFR was built. This value is from the mpfr.h that was in use when the compilation of Math::MPFR took place. $ui = MPFR_VERSION_NUM($major, $minor, $patchlevel); Returns the value for MPFR_VERSION on "MPFR-$major.$minor.$patchlevel". $str = Rmpfr_get_patches(); Return a string containing the ids of the patches applied to the MPFR library (contents of the `PATCHES' file), separated by spaces. Note: If the program has been compiled with an older MPFR version and is dynamically linked with a new MPFR library version, the ids of the patches applied to the old (compile-time) MPFR version are not available (however this information should not have much interest in general). $bool = Rmpfr_buildopt_tls_p(); # mpfr-3.0.0 and later only Return a non-zero value if mpfr was compiled as thread safe using compiler-level Thread Local Storage (that is mpfr was built with the `--enable-thread-safe' configure option), else return zero. $bool = Rmpfr_buildopt_decimal_p(); # mpfr-3.0.0 and later only Return a non-zero value if mpfr was compiled with decimal float support (that is mpfr was built with the `--enable-decimal-float' configure option), return zero otherwise. $bool = Rmpfr_buildopt_gmpinternals_p(); # mpfr-3.1.0 and later only Return a non-zero value if mpfr was compiled with gmp internals (that is, mpfr was built with either '--with-gmp-build' or '--enable-gmp-internals' configure option), return zero otherwise. $str = Rmpfr_buildopt_tune_case(); # mpfr-3.1.0 and later only Return a string saying which thresholds file has been used at compile time. This file is normally selected from the processor type. If "make tune" has been used, then it will return "src/mparam.h". Otherwise it will say which official mparam.h file has been used. $si = Rmpfr_rint($rop, $op, $rnd); $si = Rmpfr_ceil($rop, $op); $si = Rmpfr_floor($rop, $op); $si = Rmpfr_round($rop, $op); $si = Rmpfr_trunc($rop, $op); Set $rop to $op rounded to an integer. `Rmpfr_ceil' rounds to the next higher representable integer, `Rmpfr_floor' to the next lower, `Rmpfr_round' to the nearest representable integer, rounding halfway cases away from zero, and `Rmpfr_trunc' to the representable integer towards zero. `Rmpfr_rint' behaves like one of these four functions, depending on the rounding mode. The returned value is zero when the result is exact, positive when it is greater than the original value of $op, and negative when it is smaller. More precisely, the returned value is 0 when $op is an integer representable in $rop, 1 or -1 when $op is an integer that is not representable in $rop, 2 or -2 when $op is not an integer. $si = Rmpfr_rint_ceil($rop, $op, $rnd); $si = Rmpfr_rint_floor($rop, $op, $rnd); $si = Rmpfr_rint_round($rop, $op, $rnd); $si = Rmpfr_rint_trunc($rop, $op, $rnd): Set $rop to $op rounded to an integer. `Rmpfr_rint_ceil' rounds to the next higher or equal integer, `Rmpfr_rint_floor' to the next lower or equal integer, `Rmpfr_rint_round' to the nearest integer, rounding halfway cases away from zero, and `Rmpfr_rint_trunc' to the next integer towards zero. If the result is not representable, it is rounded in the direction $rnd. The returned value is the ternary value associated with the considered round-to-integer function (regarded in the same way as any other mathematical function). $si = Rmpfr_frac($rop, $op, $round); Set $rop to the fractional part of $op, having the same sign as $op, rounded in the direction $round (unlike in `mpfr_rint', $round affects only how the exact fractional part is rounded, not how the fractional part is generated). $si = Rmpfr_modf ($rop1, $rop2, $op, $rnd); Set simultaneously $rop1 to the integral part of $op and $rop2 to the fractional part of $op, rounded in the direction RND with the corresponding precision of $rop1 and $rop2 (equivalent to `Rmpfr_trunc($rop1, $op, $rnd)' and `Rmpfr_frac($rop1, $op, $rnd)'). The variables $rop1 and $rop2 must be different. Return 0 iff both results are exact. $si = Rmpfr_remainder($rop, $op1, $op2, $rnd); $si = Rmpfr_fmod($rop, $op1, $op2, $rnd); ($si2, $si) = Rmpfr_remquo ($rop, $op1, $op2, $rnd); Set $rop to the remainder of the division of $op1 by $op2, with quotient rounded toward zero for 'Rmpfr_fmod' and to the nearest integer (ties rounded to even) for 'Rmpfr_remainder' and 'Rmpfr_remquo', and $rop rounded according to the direction $rnd. Special values are handled as described in Section F.9.7.1 of the ISO C99 standard: If $op1 is infinite or $op2 is zero, $rop is NaN. If $op2 is infinite and $op1 is finite, $rop is $op1 rounded to the precision of $rop. If $rop is zero, it has the sign of $op1. The return value is the ternary value corresponding to $rop. Additionally, `Rmpfr_remquo' stores the low significant bits from the quotient in $si2 (more precisely the number of bits in a `long' minus one), with the sign of $op1 divided by $op2 (except if those low bits are all zero, in which case zero is returned). Note that $op1 may be so large in magnitude relative to $op2 that an exact representation of the quotient is not practical. `Rmpfr_remainder' and `Rmpfr_remquo' functions are useful for additive argument reduction. $si = Rmpfr_integer_p($op); Return non-zero iff $op is an integer. Rmpfr_nexttoward($op1, $op2); If $op1 or $op2 is NaN, set $op1 to NaN. Otherwise, if $op1 is different from $op2, replace $op1 by the next floating-point number (with the precision of $op1 and the current exponent range) in the direction of $op2, if there is one (the infinite values are seen as the smallest and largest floating-point numbers). If the result is zero, it keeps the same sign. No underflow or overflow is generated. Rmpfr_nextabove($op1); Equivalent to `mpfr_nexttoward' where $op2 is plus infinity. Rmpfr_nextbelow($op1); Equivalent to `mpfr_nexttoward' where $op2 is minus infinity. $si = Rmpfr_min($rop, $op1, $op2, $round); Set $rop to the minimum of $op1 and $op2. If $op1 and $op2 are both NaN, then $rop is set to NaN. If $op1 or $op2 is NaN, then $rop is set to the numeric value. If $op1 and $op2 are zeros of different signs, then $rop is set to -0. $si = Rmpfr_max($rop, $op1, $op2, $round); Set $rop to the maximum of $op1 and $op2. If $op1 and $op2 are both NaN, then $rop is set to NaN. If $op1 or $op2 is NaN, then $rop is set to the numeric value. If $op1 and $op2 are zeros of different signs, then $rop is set to +0. $iv = Math::MPFR::nnumflag(); # not exported Returns the value of the non-numeric flag. This flag is initialized to zero, but incemented by 1 whenever the a string containing non-numeric characters is passed to an mpfr function. The value of the flag therefore tells us how many times such strings were passed to mpfr functions . The flag can be reset to 0 by running clear_nnum(). Math::MPFR::set_nnum($iv); # not exported Resets the global non-numeric flag to the value specified by $iv. Math::MPFR::clear_nnum(); # not exported Resets the global non-numeric flag to 0.(Essentially the same as running set_nnum(0).) $bytes = Math::MPFR::bytes($val, $type); $type must be either 'double', 'long double', 'double-double', or '__float128', though both upper and lower cases of the characters is acceptable. $val must either be a string (eg '1.6e+45', '2.3', '0x17.8') or a Math::MPFR object. For the given value expressed by the string (or encapsulated in the object) the hex representation of that value for the given ($type) datatype is returned. If $val is a Math::MPFR object, its precision must be 53 if $type is double, 64 if $type is 'long double', 106 if $type is 'double-double', or 113 if $type is '__float128'. NOTE: Setting $type to '__float128' causes a fatal error if Math::MPFR::MPFR_WANT_FLOAT128() returns false. ############## RANDOM NUMBERS Rmpfr_urandomb(@r, $state); Each member of @r is a Math::MPFR object. $state is a reference to a gmp_randstate_t structure. Set each member of @r to a uniformly distributed random float in the interval 0 <= $_ < 1. Before using this function you must first create $state by calling one of the 4 Rmpfr_randinit functions, then seed $state by calling one of the 2 Rmpfr_randseed functions. The memory associated with $state will be freed automatically when $state goes out of scope. Rmpfr_random2($rop, $si, $ui); # not implemented in # mpfr-3.0.0 and later Attempting to use this function when Math::MPFR has been built against mpfr-3.0.0 (or later) will cause the program to die, with an appropriate error message. Generate a random float of at most abs($si) limbs, with long strings of zeros and ones in the binary representation. The exponent of the number is in the interval -$ui to $ui. This function is useful for testing functions and algorithms, since this kind of random numbers have proven to be more likely to trigger corner-case bugs. Negative random numbers are generated when $si is negative. $si = Rmpfr_urandom ($rop, $state, $rnd); # mpfr-3.0.0 and # later only Generate a uniformly distributed random float. The floating-point number $rop can be seen as if a random real number is generated according to the continuous uniform distribution on the interval[0, 1] and then rounded in the direction RND. Before using this function you must first create $state by calling one of the Rmpfr_randinit functions (below), then seed $state by calling one of the Rmpfr_randseed functions. $si = Rmpfr_grandom($rop1, $rop2, $state, $rnd); Available only with mpfr-3.1.0 and later. Generate two random floats according to a standard normal gaussian distribution. The floating-point numbers $rop1 and $rop2 can be seen as if a random real number were generated according to the standard normal gaussian distribution and then rounded in the direction $rnd. Before using this function you must first create $state by calling one of the Rmpfr_randinit functions (below), then seed $state by calling one of the Rmpfr_randseed functions. $state = Rmpfr_randinit_default(); Initialise $state with a default algorithm. This will be a compromise between speed and randomness, and is recommended for applications with no special requirements. $state = Rmpfr_randinit_mt(); Initialize state for a Mersenne Twister algorithm. This algorithm is fast and has good randomness properties. $state = Rmpfr_randinit_lc_2exp($a, $c, $m2exp); This function is not tested in the test suite. Use with caution - I often select values here that cause Rmpf_urandomb() to behave non-randomly. Initialise $state with a linear congruential algorithm: X = ($a * X + $c) % 2 ** $m2exp The low bits in X are not very random - for this reason only the high half of each X is actually used. $c and $m2exp sre both unsigned longs. $a can be any one of Math::GMP, or Math::GMPz objects. Or it can be a string. If it is a string of hex digits it must be prefixed with either OX or Ox. If it is a string of octal digits it must be prefixed with 'O'. Else it is assumed to be a decimal integer. No other bases are allowed. $state = Rmpfr_randinit_lc_2exp_size($ui); Initialise state as per Rmpfr_randinit_lc_2exp. The values for $a, $c. and $m2exp are selected from a table, chosen so that $ui bits (or more) of each X will be used. Rmpfr_randseed($state, $seed); $state is a reference to a gmp_randstate_t strucure (the return value of one of the Rmpfr_randinit functions). $seed is the seed. It can be any one of Math::GMP, or Math::GMPz objects. Or it can be a string of digits. If it is a string of hex digits it must be prefixed with either OX or Ox. If it is a string of octal digits it must be prefixed with 'O'. Else it is assumed to be a decimal integer. No other bases are allowed. Rmpfr_randseed_ui($state, $ui); $state is a reference to a gmp_randstate_t strucure (the return value of one of the Rmpfr_randinit functions). $ui is the seed. ######### INTERNALS $bool = Rmpfr_can_round($op, $ui, $rnd1, $rnd2, $p); Assuming $op is an approximation of an unknown number X in direction $rnd1 with error at most two to the power E(b)-$ui where E(b) is the exponent of $op, returns 1 if one is able to round exactly X to precision $p with direction $rnd2, and 0 otherwise. This function *does not modify* its arguments. $str = Rmpfr_print_rnd_mode($rnd); Return a string ("MPFR_RNDD", "MPFR_RNDU", "MPFR_RNDN", "MPFR_RNDZ", "MPFR_RNDA") corresponding to the rounding mode $rnd, or return undef if $rnd is an invalid rounding mode. $si = Rmpfr_get_exp($op); Get the exponent of $op, assuming that $op is a non-zero ordinary number. $si = Rmpfr_set_exp($op, $si); Set the exponent of $op if $si is in the current exponent range, and return 0 (even if $op is not a non-zero ordinary number); otherwise, return a non-zero value. $si = Rmpfr_signbit ($op); Return a non-zero value iff $op has its sign bit set (i.e. if it is negative, -0, or a NaN whose representation has its sign bit set). $si2 = Rmpfr_setsign ($rop, $op, $si, $rnd); Set the value of $rop from $op, rounded towards the given direction $rnd, then set/clear its sign bit if $si is true/false (even when $op is a NaN). $si = Rmpfr_copysign ($rop, $op1, $op2, $rnd); Set the value of $rop from $op1, rounded towards the given direction $rnd, then set its sign bit to that of $op2 (even when $op1 or $op2 is a NaN). This function is equivalent to: Rmpfr_setsign ($rop, $op1, Rmpfr_signbit ($op2), $rnd)'. #################### OPERATOR OVERLOADING Overloading works with numbers, strings (bases 2, 10, and 16 only - see step '4.' below) and Math::MPFR objects. Overloaded operations are performed using the current "default rounding mode" (which you can determine using the 'Rmpfr_get_default_rounding_mode' function, and change using the 'Rmpfr_set_default_rounding_mode' function). Be aware that when you use overloading with a string operand, the overload subroutine converts that string operand to a Math::MPFR object with *current default precision*, and using the *current default rounding mode*. Note that any comparison using the spaceship operator ( <=> ) will return undef iff either/both of the operands is a NaN. All comparisons ( < <= > >= == != <=> ) involving one or more NaNs will set the erange flag. For the purposes of the overloaded 'not', '!' and 'bool' operators, a "false" Math::MPFR object is one whose value is either 0 (including -0) or NaN. (A "true" Math::MPFR object is, of course, simply one that is not "false".) The following operators are overloaded: + - * / ** sqrt (Return object has default precision) += -= *= /= **= ++ -- (Precision remains unchanged) < <= > >= == != <=> ! bool abs atan2 cos sin log exp (Return object has default precision) int (On perl 5.8 only, NA on perl 5.6. The return object has default precision) = (The copy has the same precision as the copied object.) "" As of version 3.13 of Math::MPFR, some cross-class overloading is allowed. Let $M be a Math::MPFR object, and $G be any one of a Math::GMPz, Math::GMPq or Math::GMPf object. Then it is now permissible to do: $M + $G; $M - $G; $M * $G; $M / $G; $M ** $G; In each of the above, a Math::MPFR object containing the result of the operation is returned.It is also now permissible to do: $M += $G; $M -= $G; $M *= $G; $M /= $G; $M **= $G; If you have version 0.35 (or later) of Math::GMPz, Math::GMPq and Math::GMPf, it is also permissible to do: $G + $M; $G - $M; $G * $M; $G / $M; $G ** $M; Again, each of those operations returns a Math::MPFR object containing the result of the operation. Each operation is conducted using current default rounding mode. NOTE: If $G is a Math::GMPq object or a Math::GMPz object, then the value of $G/$M is calculated by doing 1/($M/$G). This involves *2* roundings of the value that is returned - once when $M/$G is calculated, and again when the inverse is calculated. NOTE: In overloading a ** (power) operation that involves a Math::GMPq object, it is necessary to convert the Math::GMPq object to an mpfr_t (the type of value encapsulated in the Math::MPFR object). This conversion is done using current default precision and current default rounding mode. The following is still NOT ALLOWED, and will cause a fatal error: $G += $M; $G -= $M; $G *= $M; $G /= $M; $G **= $M; In those situations where the overload subroutine operates on 2 perl variables, then obviously one of those perl variables is a Math::MPFR object. To determine the value of the other variable the subroutine works through the following steps (in order), using the first value it finds, or croaking if it gets to step 6: 1. If the variable is a UV (unsigned integer value) then that value is used. The variable is considered to be a UV if (perl 5.8) the UOK flag is set or if (perl 5.6) SvIsUV() returns true. 2. If the variable is an IV (signed integer value) then that value is used. The variable is considered to be an IV if the IOK flag is set. 3. If the variable is an NV (floating point value) then that value is used. The variable is considered to be an NV if the NOK flag is set. 4. If the variable is a string (ie the POK flag is set) then the value of that string is used. If the POK flag is set, but the string is not a valid number, the subroutine croaks with an appropriate error message. If the string starts with '0b' or '0B' it is regarded as a base 2 number. If it starts with '0x' or '0X' it is regarded as a base 16 number. Otherwise it is regarded as a base 10 number. 5. If the variable is a Math::MPFR, Math::GMPz, Math::GMPf, or Math::GMPq object then the value of that object is used. 6. If none of the above is true, then the second variable is deemed to be of an invalid type. The subroutine croaks with an appropriate error message. ##################### FORMATTED OUTPUT NOTE: When using the 'P' (precision) type specifier, instead of providing $prec to the 'P' specifier, it's now advisable to provide prec_cast($prec). The 'P' specifier expects an mp_prec_t but, prior to 3.18, we could pass it only an IV. This didn't work on at least some big-endian machines if the size of the IV was greater than the size of the mp_prec_t. The Math::MPFR::Prec package (which is part of this distribution) exists solely to provide the prec_cast sub. And the prec_cast sub's return value should be passed *only* to the 'P' type specifier. Nothing else will understand it. Passing it to something other than the 'P' specifier may produce a garbage result - might even cause a segfault. prec_cast($prec); Ensures that the 'P' type specifier will provide correct results. In Math::MPFR versions prior to 3.18 we could do only (eg) : Rmpfr_printf("%Pu\n", Rmpfr_get_prec($op)); But that didn't work correctly for all architectures. As of 3.18, that can be rewritten as: Rmpfr_printf("%Pu\n", prec_cast(Rmpfr_get_prec($op))); which should work on all architectures. Rmpfr_printf($format_string, [$rnd,] $var); This function (unlike the MPFR counterpart) is limited to taking 2 or 3 arguments - the format string, optionally a rounding argument, and the variable to be formatted. That is, you can currently printf only one variable at a time. If there's no variable to be formatted, just add a '0' as the final argument. ie this will work fine: Rmpfr_printf("hello world\n", 0); NOTE: The rounding argument $rnd can be provided *only* if $var is a Math::MPFR object. To do otherwise is a fatal error. See the mpfr documentation for details re the formatting options: http://www.mpfr.org/mpfr-current/mpfr.html#Formatted-Output-Functions Rmpfr_fprintf($fh, $format_string, [$rnd,] $var); This function (unlike the MPFR counterpart) is limited to taking 3 or 4 arguments - the filehandle, the format string, optionally a rounding argument, and the variable to be formatted. That is, you can printf only one variable at a time. If there's no variable to be formatted, just add a '0' as the final argument. ie this will work fine: Rmpfr_fprintf($fh, "hello world\n", 0); NOTE: The rounding argument $rnd can be provided *only* if $var is a Math::MPFR object. To do otherwise is a fatal error. See the mpfr documentation for details re the formatting options: http://www.mpfr.org/mpfr-current/mpfr.html#Formatted-Output-Functions Rmpfr_sprintf($buffer, $format_string, [$rnd,] $var, $buflen); This function (unlike the MPFR counterpart) is limited to taking 4 or 5 arguments - the buffer, the format string, optionally a rounding argument, the variable to be formatted and the size of the buffer ($buflen) into which the result will be written. $buflen must specify a size (characters) that is at least large enough to accommodate the formatted string (including the terminating NULL). The formatted string will be placed in $buffer. If there's no variable to be formatted, just insert a '0' as the value for $var. ie this will work fine: Rmpfr_sprintf($buffer, "hello world", 0, $buflen); NOTE: The rounding argument $rnd can be provided *only* if $var is a Math::MPFR object. To do otherwise is a fatal error. See the mpfr documentation for details re the formatting options: http://www.mpfr.org/mpfr-current/mpfr.html#Formatted-Output-Functions Rmpfr_snprintf($buffer, $bytes, $format_string, [$rnd,] $var, $buflen); This function (unlike the MPFR counterpart) is limited to taking 5 or 6 arguments - the buffer, the number of bytes to be written, the format string, optionally a rounding argument, the variable to be formatted and the size of the buffer ($buflen). $buflen must specify a size (characters) that is at least large enough to accommodate the formatted string (including the terminating NULL). The formatted string will be placed in $buffer. If there's no variable to be formatted, just insert a '0' as the value for $arg. ie this will work fine: Rmpfr_snprintf($buffer, 12, "hello world", 0, $buflen); NOTE: The rounding argument $rnd can be provided *only* if $var is a Math::MPFR object. To do otherwise is a fatal error. See the mpfr documentation for further details: http://www.mpfr.org/mpfr-current/mpfr.html#Formatted-Output-Functions ##################### BASE CONVERSIONS $DBL_DIG = MPFR_DBL_DIG; # Will be undef if float.h doesn't define # DBL_DIG. $LDBL_DIG = MPFR_LDBL_DIG; # Will be undef if float.h doesn't define # LDBL_DIG. $FLT128_DIG = MPFR_FLT128_DIG; # Will be undef if quadmath.h has not # been loaded, or quadmath.h does not # define FLT128_DIG . $min_prec = mpfr_min_inter_prec($orig_base, $orig_length, $to_base); $max_len = mpfr_max_orig_len($orig_base, $to_base, $to_prec); $min_base = mpfr_min_inter_base($orig_base, $orig_length, $to_prec); $max_base = mpfr_max_orig_base($orig_length, $to_base, $to_prec); The last 4 of the above functions establish the relationship between $orig_base, $orig_length, $to_base and $to_prec. Given any 3 of those 4, there's a function there to determine the value of the 4th. Let's say we have some base 10 floating point numbers comprising 16 significant digits, and we want to convert those numbers to a base 2 data type (say, 'long double'). If we then convert the value of that long double to a 16-digit base 10 float are we guaranteed of getting the original value back ? It all depends upon the precision of the 'long double' type, and the min_inter_prec() subroutine will tell you what the minimum required precision is (in order to be sure of getting the original value back). We have: $min_prec = mpfr_min_inter_prec($orig_base, $orig_length, $to_base); In our example case that becomes: $min_prec = mpfr_min_inter_prec(10, 16, 2); which will set $min_prec to 55. That is, so long as the long double type has a precision of at least 55 bits, you can pass 16-digit, base 10, floating point values to it and back again, and be assured of retrieving the original value. (Naturally, this is assuming absence of buggy behaviour, and correct rounding practice.) Similarly, you might like to know the maximum significant number of base 10 digits that can be specified, when assigning to (say) a 53-bit double. We have: $max_len = mpfr_max_orig_len($orig_base, $to_base, $to_prec); For this second example that becomes: $max_len = mpfr_max_orig_len(10, 2, 53); which will set $max_len to 15. That is, so long as your base 10 float consists of no more than 15 siginificant digits, you can pass it to a 53-bit double and back again, and be assured of retrieving the original value. (Again, we assume absence of bugs and correct rounding practice.) It is to be expected that mpfr_max_orig_len(10, 2, $double_prec) and mpfr_max_orig_len(10, 2, $long_double_prec) will (resp.) return the same values as MPFR_DBL_DIG and MPFR_LDBL_DIG. ($double_prec is the precision, in bits, of the C 'double' type, and $long_double_prec is the precision, in bits, of the C 'long double' type.) The last 2 of the above subroutines (ie mpfr_min_inter_base and mpfr_max_orig_base) are provided mainly for completeness. Normally, there wouldn't be a need to use these last 2 forms ... but who knows ... The above examples demonstrate usage in relation to conversion between bases 2 and 10. The functions apply just as well to conversions between bases of any values. The Math::LongDouble module provides 4 identical functions, prefixed with 'ld_' instead of 'mpfr_' (to avoid name clashes). Similarly, it provides constants (prefixed with 'LD_' instead of 'MPFR_') that reflect the values of float.h's DBL_DIG and LDBL_DIG. ##################### =head1 BUGS You can get segfaults if you pass the wrong type of argument to the functions - so if you get a segfault, the first thing to do is to check that the argument types you have supplied are appropriate. =head1 ACKNOWLEDGEMENTS Thanks to Vincent Lefevre for providing corrections to errors and omissions, and suggesting improvements (which were duly put in place). =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. Copyright 2006-2016 Sisyphus =head1 AUTHOR Sisyphus =cut Math-MPFR-3.32/MPFR.xs0000644000076400010400000101030512660557734015703 0ustar sisyphusAdministrators #ifdef __MINGW32__ #ifndef __USE_MINGW_ANSI_STDIO #define __USE_MINGW_ANSI_STDIO 1 #endif #endif #define PERL_NO_GET_CONTEXT 1 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #if defined MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER #include #endif #endif #include #include #include #ifdef MPFR_WANT_FLOAT128 #include #if defined(NV_IS_FLOAT128) && defined(MPFR_VERSION) && MPFR_VERSION >= MPFR_VERSION_NUM(3,2,0) #define CAN_PASS_FLOAT128 #endif #if defined(__MINGW32__) && !defined(__MINGW64__) typedef __float128 float128 __attribute__ ((aligned(32))); #elif defined(__MINGW64__) typedef __float128 float128 __attribute__ ((aligned(8))); #else typedef __float128 float128; #endif #endif #if LDBL_MANT_DIG == 106 #define REQUIRED_LDBL_MANT_DIG 2098 #else #define REQUIRED_LDBL_MANT_DIG LDBL_MANT_DIG #endif #if defined(MPFR_VERSION_MAJOR) && MPFR_VERSION_MAJOR >= 3 #define MAXIMUM_ALLOWABLE_BASE 62 #else #define MAXIMUM_ALLOWABLE_BASE 36 #endif #if MPFR_VERSION_MAJOR < 3 #define CHECK_ROUNDING_VALUE \ if((mp_rnd_t)SvUV(round) > 3) \ croak("Illegal rounding value supplied for this version (%s) of the mpfr library", MPFR_VERSION_STRING); #else #define CHECK_ROUNDING_VALUE #endif #define NEG_ZERO_BUG 196866 /* A bug affecting mpfr_fits_u*_p functions */ /* Fixed in mpfr after MPFR_VERSION 196866 (3.1.2) */ /* For earlier versions of mpfr, we fix this bug in */ /* our own code */ #define LNGAMMA_BUG 196867 /* lngamma(-0) set to NaN instead of +Inf */ /* Fixed in mpfr after MPFR_VERSION 196867 (3.1.3) */ /* For earlier versions of mpfr, we fix this bug in */ /* our own code */ /* Squash some annoying compiler warnings (Microsoft compilers only). */ #ifdef _MSC_VER #pragma warning(disable:4700 4715 4716) #endif #ifdef OLDPERL #define SvUOK SvIsUV #endif #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) #endif #ifndef Newxz # define Newxz(v,n,t) Newz(0,v,n,t) #endif /* May one day be removed from mpfr.h */ #ifndef mp_rnd_t # define mp_rnd_t mpfr_rnd_t #endif #ifndef mp_prec_t # define mp_prec_t mpfr_prec_t #endif #ifndef __gmpfr_default_rounding_mode #define __gmpfr_default_rounding_mode mpfr_get_default_rounding_mode() #endif #if !defined(__GNU_MP_VERSION) || __GNU_MP_VERSION < 5 #define mp_bitcnt_t unsigned long int #endif int nnum = 0; /* flag that is incremented whenever a string containing non-numeric characters is treated as a number */ /* Has inttypes.h been included ? */ int _has_inttypes(void) { #ifdef _MSC_VER return 0; #else #if defined MATH_MPFR_NEED_LONG_LONG_INT return 1; #else return 0; #endif #endif } int NNW_val(pTHX) { /* return the numeric value of $Math::MPFR::NNW */ return SvIV(get_sv("Math::MPFR::NNW", 0)); } void Rmpfr_set_default_rounding_mode(pTHX_ SV * round) { CHECK_ROUNDING_VALUE mpfr_set_default_rounding_mode((mp_rnd_t)SvUV(round)); } unsigned long Rmpfr_get_default_rounding_mode(void) { return __gmpfr_default_rounding_mode; } SV * Rmpfr_prec_round(pTHX_ mpfr_t * p, SV * prec, SV * round) { return newSViv(mpfr_prec_round(*p, (mpfr_prec_t)SvIV(prec), (mp_rnd_t)SvUV(round))); } void DESTROY(pTHX_ mpfr_t * p) { mpfr_clear(*p); Safefree(p); } void Rmpfr_clear(pTHX_ mpfr_t * p) { mpfr_clear(*p); Safefree(p); } void Rmpfr_clear_mpfr(mpfr_t * p) { mpfr_clear(*p); } void Rmpfr_clear_ptr(pTHX_ mpfr_t * p) { Safefree(p); } void Rmpfr_clears(pTHX_ SV * p, ...) { dXSARGS; unsigned long i; for(i = 0; i < items; i++) { mpfr_clear(*(INT2PTR(mpfr_t *, SvIV(SvRV(ST(i)))))); Safefree(INT2PTR(mpfr_t *, SvIV(SvRV(ST(i))))); } XSRETURN(0); } SV * Rmpfr_init(pTHX) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_init2(pTHX_ SV * prec) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init2 function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init2 (*mpfr_t_obj, (mpfr_prec_t)SvIV(prec)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_init_nobless(pTHX) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_init2_nobless(pTHX_ SV * prec) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init2_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); mpfr_init2 (*mpfr_t_obj, (mpfr_prec_t)SvIV(prec)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } void Rmpfr_init_set(pTHX_ mpfr_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_ui(pTHX_ SV * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_ui function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_ui(*mpfr_t_obj, (unsigned long)SvUV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_si(pTHX_ SV * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_si function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_si(*mpfr_t_obj, (long)SvIV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_d(pTHX_ SV * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_d function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_d(*mpfr_t_obj, (double)SvNV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_ld(pTHX_ SV * q, SV * round) { #ifdef USE_LONG_DOUBLE #ifndef _MSC_VER dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_d function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_ld(*mpfr_t_obj, (long double)SvNV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); #else croak("Rmpfr_init_set_ld not implemented on this build of perl - use Rmpfr_init_set_d instead"); #endif #else croak("Rmpfr_init_set_ld not implemented on this build of perl"); #endif } void Rmpfr_init_set_f(pTHX_ mpf_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_f function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_f(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_z(pTHX_ mpz_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_z function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_z(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_q(pTHX_ mpq_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_q function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); ret = mpfr_init_set_q(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_str(pTHX_ SV * q, SV * base, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret = (int)SvIV(base); CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ if(ret < 0 || ret > MAXIMUM_ALLOWABLE_BASE || ret == 1) croak("2nd argument supplied to Rmpfr_init_set str is out of allowable range"); Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_str function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ret = mpfr_init_set_str(*mpfr_t_obj, SvPV_nolen(q), ret, (mp_rnd_t)SvUV(round)); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("1st arg given to Rmpfr_init_set_str contains non-numeric characters"); } ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_nobless(pTHX_ mpfr_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_ui_nobless(pTHX_ SV * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_ui_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_ui(*mpfr_t_obj, (unsigned long)SvUV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_si_nobless(pTHX_ SV * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_si_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_si(*mpfr_t_obj, (long)SvIV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_d_nobless(pTHX_ SV * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_d_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_d(*mpfr_t_obj, (double)SvNV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_ld_nobless(pTHX_ SV * q, SV * round) { #ifdef USE_LONG_DOUBLE #ifndef _MSC_VER dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_d_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_ld(*mpfr_t_obj, (long double)SvNV(q), (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); #else croak("Rmpfr_init_set_ld_nobless not implemented on this build of perl - use Rmpfr_init_set_d_nobless instead"); #endif #else croak("Rmpfr_init_set_ld_nobless not implemented on this build of perl"); #endif } void Rmpfr_init_set_f_nobless(pTHX_ mpf_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_f_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_f(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_z_nobless(pTHX_ mpz_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_z_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_z(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_q_nobless(pTHX_ mpq_t * q, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret; CHECK_ROUNDING_VALUE /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_q_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); ret = mpfr_init_set_q(*mpfr_t_obj, *q, (mp_rnd_t)SvUV(round)); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_init_set_str_nobless(pTHX_ SV * q, SV * base, SV * round) { dXSARGS; mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; int ret = (int)SvIV(base); CHECK_ROUNDING_VALUE if(ret < 0 || ret > MAXIMUM_ALLOWABLE_BASE || ret == 1) croak("2nd argument supplied to Rmpfr_init_set_str_nobless is out of allowable range"); /* sp = mark; *//* not needed */ Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in Rmpfr_init_set_str_nobless function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); ret = mpfr_init_set_str(*mpfr_t_obj, SvPV_nolen(q), ret, (mp_rnd_t)SvUV(round)); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("1st arg given to Rmpfr_init_set_str_nobless contains non-numeric characters"); } ST(0) = sv_2mortal(obj_ref); ST(1) = sv_2mortal(newSViv(ret)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_deref2(pTHX_ mpfr_t * p, SV * base, SV * n_digits, SV * round) { dXSARGS; char * out; mp_exp_t ptr; unsigned long b = (unsigned long)SvUV(base); CHECK_ROUNDING_VALUE if(b < 2 || b > MAXIMUM_ALLOWABLE_BASE) croak("Second argument supplied to Rmpfr_get_str is not in acceptable range"); out = mpfr_get_str(0, &ptr, b, (unsigned long)SvUV(n_digits), *p, (mp_rnd_t)SvUV(round)); if(out == NULL) croak("An error occurred in mpfr_get_str\n"); /* sp = mark; *//* not needed */ ST(0) = sv_2mortal(newSVpv(out, 0)); mpfr_free_str(out); ST(1) = sv_2mortal(newSViv(ptr)); /* PUTBACK; *//* not needed */ XSRETURN(2); } void Rmpfr_set_default_prec(pTHX_ SV * prec) { mpfr_set_default_prec((mpfr_prec_t)SvIV(prec)); } SV * Rmpfr_get_default_prec(pTHX) { return newSViv(mpfr_get_default_prec()); } SV * Rmpfr_min_prec(pTHX_ mpfr_t * x) { #if MPFR_VERSION_MAJOR >= 3 return newSViv((mpfr_prec_t)mpfr_min_prec(*x)); #else croak("Rmpfr_min_prec function not implemented for mpfr versions prior to version 3"); #endif } void Rmpfr_set_prec(pTHX_ mpfr_t * p, SV * prec) { mpfr_set_prec(*p, (mpfr_prec_t)SvIV(prec)); } void Rmpfr_set_prec_raw(pTHX_ mpfr_t * p, SV * prec) { mpfr_set_prec_raw(*p, (mpfr_prec_t)SvIV(prec)); } SV * Rmpfr_get_prec(pTHX_ mpfr_t * p) { return newSViv(mpfr_get_prec(*p)); } SV * Rmpfr_set(pTHX_ mpfr_t * p, mpfr_t * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set(*p, *q, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_ui(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set_ui(*p, (unsigned long)SvUV(q), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_si(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set_si(*p, (long)SvIV(q), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_uj(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER return newSViv(mpfr_set_uj(*p, SvUV(q), (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_set_uj not implemented on this build of perl - use Rmpfr_set_str instead"); #endif #else croak("Rmpfr_set_uj not implemented on this build of perl"); #endif } SV * Rmpfr_set_sj(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER return newSViv(mpfr_set_sj(*p, SvIV(q), (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_set_sj not implemented on this build of perl - use Rmpfr_set_str instead"); #endif #else croak("Rmpfr_set_sj not implemented on this build of perl"); #endif } SV * Rmpfr_set_NV(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE #if defined(USE_LONG_DOUBLE) && !defined(_MSC_VER) && !defined(CAN_PASS_FLOAT128) return newSViv(mpfr_set_ld(*p, (long double)SvNV(q), (mp_rnd_t)SvUV(round))); #elif defined(CAN_PASS_FLOAT128) return newSViv(mpfr_set_float128(*p, (float128)SvNV(q), (mp_rnd_t)SvUV(round))); #else return newSViv(mpfr_set_d (*p, (double)SvNV(q), (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_set_ld(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE #ifdef USE_LONG_DOUBLE #ifndef _MSC_VER return newSViv(mpfr_set_ld(*p, (long double)SvNV(q), (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_set_ld not implemented on this build of perl - use Rmpfr_set_d instead"); #endif #else croak("Rmpfr_set_ld not implemented on this build of perl"); #endif } SV * Rmpfr_set_d(pTHX_ mpfr_t * p, SV * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set_d(*p, (double)SvNV(q), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_z(pTHX_ mpfr_t * p, mpz_t * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set_z(*p, *q, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_q(pTHX_ mpfr_t * p, mpq_t * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set_q(*p, *q, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_f(pTHX_ mpfr_t * p, mpf_t * q, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_set_f(*p, *q, (mp_rnd_t)SvUV(round))); } int Rmpfr_set_str(pTHX_ mpfr_t * p, SV * num, SV * base, SV * round) { int ret, b = (int)SvIV(base); CHECK_ROUNDING_VALUE if(b < 0 || b > MAXIMUM_ALLOWABLE_BASE || b == 1) croak("3rd argument supplied to Rmpfr_set_str is out of allowable range"); ret = mpfr_set_str(*p, SvPV_nolen(num), b, (mp_rnd_t)SvUV(round)); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("1st arg given to Rmpfr_init_set_str contains non-numeric characters"); } return ret; } /* Removed in Math-MPFR-3.30. Should have been removed much earlier void Rmpfr_set_str_binary(pTHX_ mpfr_t * p, SV * str) { mpfr_set_str_binary(*p, SvPV_nolen(str)); } */ void Rmpfr_set_inf(mpfr_t * p, int sign) { mpfr_set_inf(*p, sign); } void Rmpfr_set_nan(mpfr_t * p) { mpfr_set_nan(*p); } void Rmpfr_swap(mpfr_t *p, mpfr_t * q) { mpfr_swap(*p, *q); } SV * Rmpfr_get_d(pTHX_ mpfr_t * p, SV * round){ CHECK_ROUNDING_VALUE return newSVnv(mpfr_get_d(*p, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_get_d_2exp(pTHX_ SV * exp, mpfr_t * p, SV * round){ long _exp; double ret; CHECK_ROUNDING_VALUE ret = mpfr_get_d_2exp(&_exp, *p, (mp_rnd_t)SvUV(round)); sv_setiv(exp, _exp); return newSVnv(ret); } SV * Rmpfr_get_ld_2exp(pTHX_ SV * exp, mpfr_t * p, SV * round){ #ifdef USE_LONG_DOUBLE #ifndef _MSC_VER long _exp; long double ret; CHECK_ROUNDING_VALUE ret = mpfr_get_ld_2exp(&_exp, *p, (mp_rnd_t)SvUV(round)); sv_setiv(exp, _exp); return newSVnv(ret); #else croak("Rmpfr_get_ld_2exp not implemented on this build of perl - use Rmpfr_get_d_2exp instead"); #endif #else croak("Rmpfr_get_ld_2exp not implemented on this build of perl"); #endif } SV * Rmpfr_get_ld(pTHX_ mpfr_t * p, SV * round){ CHECK_ROUNDING_VALUE #ifdef USE_LONG_DOUBLE #ifndef _MSC_VER return newSVnv(mpfr_get_ld(*p, (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_get_ld not implemented on this build of perl - use Rmpfr_get_d instead"); #endif #else croak("Rmpfr_get_ld not implemented on this build of perl"); #endif } double Rmpfr_get_d1(mpfr_t * p) { return mpfr_get_d1(*p); } /* Alias for the perl function Rmpfr_get_z_exp * (which will perhaps one day be removed). * The mpfr headers define 'mpfr_get_z_exp' to * 'mpfr_get_z_2exp' when that function is * available. */ SV * Rmpfr_get_z_2exp(pTHX_ mpz_t * z, mpfr_t * p){ return newSViv(mpfr_get_z_exp(*z, *p)); } SV * Rmpfr_add(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_add(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_add_ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_add_ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_add_d(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_add_d(*a, *b, (double)SvNV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_add_si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_add_si(*a, *b, (int)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_add_z(pTHX_ mpfr_t * a, mpfr_t * b, mpz_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_add_z(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_add_q(pTHX_ mpfr_t * a, mpfr_t * b, mpq_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_add_q(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sub(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sub(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sub_ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sub_ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sub_d(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_sub_d(*a, *b, (double)SvNV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sub_z(pTHX_ mpfr_t * a, mpfr_t * b, mpz_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sub_z(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sub_q(pTHX_ mpfr_t * a, mpfr_t * b, mpq_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sub_q(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_ui_sub(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_ui_sub(*a, (unsigned long)SvUV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_d_sub(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_d_sub(*a, (double)SvNV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_mul(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_d(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_d(*a, *b, (double)SvNV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_z(pTHX_ mpfr_t * a, mpfr_t * b, mpz_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_z(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_q(pTHX_ mpfr_t * a, mpfr_t * b, mpq_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_q(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_dim(pTHX_ mpfr_t * rop, mpfr_t * op1, mpfr_t * op2, SV * round) { CHECK_ROUNDING_VALUE int ret = mpfr_dim( *rop, *op1, *op2, (mp_rnd_t)SvUV(round)); return newSViv(ret); } SV * Rmpfr_div(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_div(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_div_ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_d(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_div_d(*a, *b, (double)SvNV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_z(pTHX_ mpfr_t * a, mpfr_t * b, mpz_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_div_z(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_q(pTHX_ mpfr_t * a, mpfr_t * b, mpq_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_div_q(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_ui_div(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_ui_div(*a, (unsigned long)SvUV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_d_div(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_d_div(*a, (double)SvNV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sqrt(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sqrt(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_rec_sqrt(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_rec_sqrt(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_cbrt(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_cbrt(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sqrt_ui(pTHX_ mpfr_t * a, SV * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sqrt_ui(*a, (unsigned long)SvUV(b), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_pow_ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_pow_ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_ui_pow_ui(pTHX_ mpfr_t * a, SV * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_ui_pow_ui(*a, (unsigned long)SvUV(b), (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_ui_pow(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_ui_pow(*a, (unsigned long)SvUV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_pow_si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_pow_si(*a, *b, (long)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_pow(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_pow(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_neg(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_neg(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_abs(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_abs(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_2exp(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_2exp(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_2ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_2ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_2si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_2si(*a, *b, (long)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_2exp(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_div_2exp(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_2ui(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_div_2ui(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_2si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_div_2si(*a, *b, (long)SvIV(c), (mp_rnd_t)SvUV(round))); } int Rmpfr_cmp(mpfr_t * a, mpfr_t * b) { return mpfr_cmp(*a, *b); } int Rmpfr_cmpabs(mpfr_t * a, mpfr_t * b) { return mpfr_cmpabs(*a, *b); } int Rmpfr_cmp_ui(mpfr_t * a, unsigned long b) { return mpfr_cmp_ui(*a, b); } int Rmpfr_cmp_d(mpfr_t * a, double b) { return mpfr_cmp_d(*a, b); } int Rmpfr_cmp_ld(pTHX_ mpfr_t * a, SV * b) { #ifdef USE_LONG_DOUBLE #ifndef _MSC_VER return mpfr_cmp_ld(*a, (long double)SvNV(b)); #else croak("Rmpfr_cmp_ld not implemented on this build of perl - use Rmpfr_cmp_d instead"); #endif #else croak("Rmpfr_cmp_ld not implemented on this build of perl"); #endif } int Rmpfr_cmp_si(mpfr_t * a, long b) { return mpfr_cmp_si(*a, b); } int Rmpfr_cmp_ui_2exp(pTHX_ mpfr_t * a, SV * b, SV * c) { return mpfr_cmp_ui_2exp(*a, (unsigned long)SvUV(b), (mp_exp_t)SvIV(c)); } int Rmpfr_cmp_si_2exp(pTHX_ mpfr_t * a, SV * b, SV * c) { return mpfr_cmp_si_2exp(*a, (long)SvIV(b), (mp_exp_t)SvIV(c)); } int Rmpfr_eq(mpfr_t * a, mpfr_t * b, unsigned long c) { return mpfr_eq(*a, *b, c); } int Rmpfr_nan_p(mpfr_t * p) { return mpfr_nan_p(*p); } int Rmpfr_inf_p(mpfr_t * p) { return mpfr_inf_p(*p); } int Rmpfr_number_p(mpfr_t * p) { return mpfr_number_p(*p); } void Rmpfr_reldiff(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE mpfr_reldiff(*a, *b, *c, (mp_rnd_t)SvUV(round)); } int Rmpfr_sgn(mpfr_t * p) { return mpfr_sgn(*p); } int Rmpfr_greater_p(mpfr_t * a, mpfr_t * b) { return mpfr_greater_p(*a, *b); } int Rmpfr_greaterequal_p(mpfr_t * a, mpfr_t * b) { return mpfr_greaterequal_p(*a, *b); } int Rmpfr_less_p(mpfr_t * a, mpfr_t * b) { return mpfr_less_p(*a, *b); } int Rmpfr_lessequal_p(mpfr_t * a, mpfr_t * b) { return mpfr_lessequal_p(*a, *b); } int Rmpfr_lessgreater_p(mpfr_t * a, mpfr_t * b) { return mpfr_lessgreater_p(*a, *b); } int Rmpfr_equal_p(mpfr_t * a, mpfr_t * b) { return mpfr_equal_p(*a, *b); } int Rmpfr_unordered_p(mpfr_t * a, mpfr_t * b) { return mpfr_unordered_p(*a, *b); } SV * Rmpfr_sin_cos(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sin_cos(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sinh_cosh(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sinh_cosh(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sin(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sin(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_cos(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_cos(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_tan(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_tan(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_asin(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_asin(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_acos(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_acos(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_atan(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_atan(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sinh(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sinh(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_cosh(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_cosh(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_tanh(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_tanh(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_asinh(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_asinh(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_acosh(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_acosh(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_atanh(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_atanh(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fac_ui(pTHX_ mpfr_t * a, SV * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_fac_ui(*a, (unsigned long)SvUV(b), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_log1p(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_log1p(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_expm1(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_expm1(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_log2(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_log2(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_log10(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_log10(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fma(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, mpfr_t * d, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_fma(*a, *b, *c, *d, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fms(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, mpfr_t * d, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_fms(*a, *b, *c, *d, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_agm(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_agm(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_hypot(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_hypot(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_const_log2(pTHX_ mpfr_t * p, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_const_log2(*p, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_const_pi(pTHX_ mpfr_t * p, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_const_pi(*p, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_const_euler(pTHX_ mpfr_t * p, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_const_euler(*p, (mp_rnd_t)SvUV(round))); } /* Removed in Math-MPFR-3.30. Should have been removed much earlier void Rmpfr_print_binary(mpfr_t * p) { mpfr_print_binary(*p); } */ SV * Rmpfr_rint(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_rint(*a, *b, (mp_rnd_t)SvUV(round))); } int Rmpfr_ceil(mpfr_t * a, mpfr_t * b) { return mpfr_ceil(*a, *b); } int Rmpfr_floor(mpfr_t * a, mpfr_t * b) { return mpfr_floor(*a, *b); } int Rmpfr_round(mpfr_t * a, mpfr_t * b) { return mpfr_round(*a, *b); } int Rmpfr_trunc(mpfr_t * a, mpfr_t * b) { return mpfr_trunc(*a, *b); } /* NO LONGER SUPPORTED SV * Rmpfr_add_one_ulp(mpfr_t * p, SV * round) { return newSViv(mpfr_add_one_ulp(*p, (mp_rnd_t)SvUV(round))); } */ /* NO LONGER SUPPORTED SV * Rmpfr_sub_one_ulp(mpfr_t * p, SV * round) { return newSViv(mpfr_sub_one_ulp(*p, (mp_rnd_t)SvUV(round))); } */ SV * Rmpfr_can_round(pTHX_ mpfr_t * p, SV * err, SV * round1, SV * round2, SV * prec) { #if MPFR_VERSION_MAJOR < 3 if((mp_rnd_t)SvUV(round1) > 3 || (mp_rnd_t)SvUV(round2) > 3) croak("Illegal rounding value supplied for this version (%s) of the mpfr library", MPFR_VERSION_STRING); #endif return newSViv(mpfr_can_round(*p, (mp_exp_t)SvIV(err), SvUV(round1), SvUV(round2), (mpfr_prec_t)SvIV(prec))); } SV * Rmpfr_print_rnd_mode(pTHX_ SV * rnd) { const char * x = mpfr_print_rnd_mode((mpfr_rnd_t)SvIV(rnd)); if(x == NULL) return &PL_sv_undef; return newSVpv(x, 0); } SV * Rmpfr_get_emin(pTHX) { return newSViv(mpfr_get_emin()); } SV * Rmpfr_get_emax(pTHX) { return newSViv(mpfr_get_emax()); } int Rmpfr_set_emin(pTHX_ SV * e) { return mpfr_set_emin((mp_exp_t)SvIV(e)); } int Rmpfr_set_emax(pTHX_ SV * e) { return mpfr_set_emax((mp_exp_t)SvIV(e)); } SV * Rmpfr_check_range(pTHX_ mpfr_t * p, SV * t, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_check_range(*p, (int)SvIV(t), (mp_rnd_t)SvUV(round))); } void Rmpfr_clear_underflow(void) { mpfr_clear_underflow(); } void Rmpfr_clear_overflow(void) { mpfr_clear_overflow(); } void Rmpfr_clear_nanflag(void) { mpfr_clear_nanflag(); } void Rmpfr_clear_inexflag(void) { mpfr_clear_inexflag(); } void Rmpfr_clear_flags(void) { mpfr_clear_flags(); } int Rmpfr_underflow_p(void) { return mpfr_underflow_p(); } int Rmpfr_overflow_p(void) { return mpfr_overflow_p(); } int Rmpfr_nanflag_p(void) { return mpfr_nanflag_p(); } int Rmpfr_inexflag_p(void) { return mpfr_inexflag_p(); } SV * Rmpfr_log(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_log(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_exp(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_exp(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_exp2(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_exp2(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_exp10(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_exp10(*a, *b, (mp_rnd_t)SvUV(round))); } void Rmpfr_urandomb(pTHX_ SV * x, ...) { dXSARGS; unsigned long i, t; t = items; --t; for(i = 0; i < t; ++i) { mpfr_urandomb(*(INT2PTR(mpfr_t *, SvIV(SvRV(ST(i))))), *(INT2PTR(gmp_randstate_t *, SvIV(SvRV(ST(t)))))); } XSRETURN(0); } void Rmpfr_random2(pTHX_ mpfr_t * p, SV * s, SV * exp) { #if MPFR_VERSION_MAJOR > 2 croak("Rmpfr_random2 no longer implemented. Use Rmpfr_urandom or Rmpfr_urandomb"); #else mpfr_random2(*p, (int)SvIV(s), (mp_exp_t)SvIV(exp)); #endif } SV * _TRmpfr_out_str(pTHX_ FILE * stream, SV * base, SV * dig, mpfr_t * p, SV * round) { size_t ret; if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("2nd argument supplied to TRmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); ret = mpfr_out_str(stream, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); fflush(stream); return newSVuv(ret); } SV * _Rmpfr_out_str(pTHX_ mpfr_t * p, SV * base, SV * dig, SV * round) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("2nd argument supplied to Rmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); ret = mpfr_out_str(NULL, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); fflush(stdout); return newSVuv(ret); } SV * _TRmpfr_out_strS(pTHX_ FILE * stream, SV * base, SV * dig, mpfr_t * p, SV * round, SV * suff) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("2nd argument supplied to TRmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); ret = mpfr_out_str(stream, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); fflush(stream); fprintf(stream, "%s", SvPV_nolen(suff)); fflush(stream); return newSVuv(ret); } SV * _TRmpfr_out_strP(pTHX_ SV * pre, FILE * stream, SV * base, SV * dig, mpfr_t * p, SV * round) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("3rd argument supplied to TRmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); fprintf(stream, "%s", SvPV_nolen(pre)); fflush(stream); ret = mpfr_out_str(stream, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); fflush(stream); return newSVuv(ret); } SV * _TRmpfr_out_strPS(pTHX_ SV * pre, FILE * stream, SV * base, SV * dig, mpfr_t * p, SV * round, SV * suff) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("3rd argument supplied to TRmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); fprintf(stream, "%s", SvPV_nolen(pre)); fflush(stream); ret = mpfr_out_str(stream, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); fflush(stream); fprintf(stream, "%s", SvPV_nolen(suff)); fflush(stream); return newSVuv(ret); } SV * _Rmpfr_out_strS(pTHX_ mpfr_t * p, SV * base, SV * dig, SV * round, SV * suff) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("2nd argument supplied to Rmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); ret = mpfr_out_str(NULL, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); printf("%s", SvPV_nolen(suff)); fflush(stdout); return newSVuv(ret); } SV * _Rmpfr_out_strP(pTHX_ SV * pre, mpfr_t * p, SV * base, SV * dig, SV * round) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("3rd argument supplied to Rmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); printf("%s", SvPV_nolen(pre)); ret = mpfr_out_str(NULL, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); fflush(stdout); return newSVuv(ret); } SV * _Rmpfr_out_strPS(pTHX_ SV * pre, mpfr_t * p, SV * base, SV * dig, SV * round, SV * suff) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("3rd argument supplied to Rmpfr_out_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); printf("%s", SvPV_nolen(pre)); ret = mpfr_out_str(NULL, (int)SvIV(base), (size_t)SvUV(dig), *p, (mp_rnd_t)SvUV(round)); printf("%s", SvPV_nolen(suff)); fflush(stdout); return newSVuv(ret); } SV * TRmpfr_inp_str(pTHX_ mpfr_t * p, FILE * stream, SV * base, SV * round) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("3rd argument supplied to TRmpfr_inp_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); ret = mpfr_inp_str(*p, stream, (int)SvIV(base), (mp_rnd_t)SvUV(round)); if(!ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("input to TRmpfr_inp_str contains non-numeric characters"); } /* fflush(stream); */ return newSVuv(ret); } SV * Rmpfr_inp_str(pTHX_ mpfr_t * p, SV * base, SV * round) { size_t ret; CHECK_ROUNDING_VALUE if(SvIV(base) < 2 || SvIV(base) > MAXIMUM_ALLOWABLE_BASE) croak("2nd argument supplied to Rmpfr_inp_str is out of allowable range (must be between 2 and %d inclusive)", MAXIMUM_ALLOWABLE_BASE); ret = mpfr_inp_str(*p, NULL, (int)SvIV(base), (mp_rnd_t)SvUV(round)); if(!ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("input to Rmpfr_inp_str contains non-numeric characters"); } /* fflush(stdin); */ return newSVuv(ret); } SV * Rmpfr_gamma(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_gamma(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_zeta(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_zeta(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_zeta_ui(pTHX_ mpfr_t * a, SV * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_zeta_ui(*a, (unsigned long)SvUV(b), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_erf(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_erf(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_frac(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_frac(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_remainder(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_remainder(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_modf(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_modf(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fmod(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_fmod(*a, *b, *c, (mp_rnd_t)SvUV(round))); } void Rmpfr_remquo(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { dXSARGS; long ret, q; CHECK_ROUNDING_VALUE ret = mpfr_remquo(*a, &q, *b, *c, (mp_rnd_t)SvUV(round)); ST(0) = sv_2mortal(newSViv(q)); ST(1) = sv_2mortal(newSViv(ret)); XSRETURN(2); } int Rmpfr_integer_p(mpfr_t * p) { return mpfr_integer_p(*p); } void Rmpfr_nexttoward(mpfr_t * a, mpfr_t * b) { mpfr_nexttoward(*a, *b); } void Rmpfr_nextabove(mpfr_t * p) { mpfr_nextabove(*p); } void Rmpfr_nextbelow(mpfr_t * p) { mpfr_nextbelow(*p); } SV * Rmpfr_min(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_min(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_max(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_max(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_get_exp(pTHX_ mpfr_t * p) { return newSViv(mpfr_get_exp(*p)); } SV * Rmpfr_set_exp(pTHX_ mpfr_t * p, SV * exp) { return newSViv(mpfr_set_exp(*p, (mp_exp_t)SvIV(exp))); } int Rmpfr_signbit(mpfr_t * op) { return mpfr_signbit(*op); } SV * Rmpfr_setsign(pTHX_ mpfr_t * rop, mpfr_t * op, SV * sign, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_setsign(*rop, *op, SvIV(sign), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_copysign(pTHX_ mpfr_t * rop, mpfr_t * op1, mpfr_t * op2, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_copysign(*rop, *op1, *op2, (mp_rnd_t)SvUV(round))); } SV * get_refcnt(pTHX_ SV * s) { return newSVuv(SvREFCNT(s)); } SV * get_package_name(pTHX_ SV * x) { if(sv_isobject(x)) return newSVpv(HvNAME(SvSTASH(SvRV(x))), 0); return newSViv(0); } void Rmpfr_dump(mpfr_t * a) { /* Once took a 'round' argument */ mpfr_dump(*a); } SV * gmp_v(pTHX) { #if __GNU_MP_VERSION >= 4 return newSVpv(gmp_version, 0); #else warn("From Math::MPFR::gmp_v(aTHX): 'gmp_version' is not implemented - returning '0'"); return newSVpv("0", 0); #endif } /* NEW in MPFR-2.1.0 */ SV * Rmpfr_set_ui_2exp(pTHX_ mpfr_t * a, SV * b, SV * c, SV * round) { return newSViv(mpfr_set_ui_2exp(*a, (unsigned long)SvUV(b), (mp_exp_t)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_si_2exp(pTHX_ mpfr_t * a, SV * b, SV * c, SV * round) { return newSViv(mpfr_set_si_2exp(*a, (long)SvIV(b), (mp_exp_t)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_set_uj_2exp(pTHX_ mpfr_t * a, SV * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER return newSViv(mpfr_set_uj_2exp(*a, SvUV(b), SvIV(c), (mp_rnd_t)SvUV(round))); #else croak ("Rmpfr_set_uj_2exp not implemented on this build of perl"); #endif #else croak ("Rmpfr_set_uj_2exp not implemented on this build of perl"); #endif } SV * Rmpfr_set_sj_2exp(pTHX_ mpfr_t * a, SV * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER return newSViv(mpfr_set_sj_2exp(*a, SvIV(b), SvIV(c), (mp_rnd_t)SvUV(round))); #else croak ("Rmpfr_set_sj_2exp not implemented on this build of perl"); #endif #else croak ("Rmpfr_set_sj_2exp not implemented on this build of perl"); #endif } SV * Rmpfr_get_z(pTHX_ mpz_t * a, mpfr_t * b, SV * round) { #if MPFR_VERSION_MAJOR < 3 CHECK_ROUNDING_VALUE mpfr_get_z(*a, *b, (mp_rnd_t)SvUV(round)); return &PL_sv_undef; #else return newSViv(mpfr_get_z(*a, *b, (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_si_sub(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_si_sub(*a, (long)SvIV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sub_si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_sub_si(*a, *b, (long)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_mul_si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_mul_si(*a, *b, (long)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_si_div(pTHX_ mpfr_t * a, SV * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_si_div(*a, (long)SvIV(b), *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_div_si(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round){ CHECK_ROUNDING_VALUE return newSViv(mpfr_div_si(*a, *b, (long)SvIV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sqr(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sqr(*a, *b, (mp_rnd_t)SvUV(round))); } int Rmpfr_cmp_z(mpfr_t * a, mpz_t * b) { return mpfr_cmp_z(*a, *b); } int Rmpfr_cmp_q(mpfr_t * a, mpq_t * b) { return mpfr_cmp_q(*a, *b); } int Rmpfr_cmp_f(mpfr_t * a, mpf_t * b) { return mpfr_cmp_f(*a, *b); } int Rmpfr_zero_p(mpfr_t * a) { return mpfr_zero_p(*a); } void Rmpfr_free_cache(void) { mpfr_free_cache(); } SV * Rmpfr_get_version(pTHX) { return newSVpv(mpfr_get_version(), 0); } SV * Rmpfr_get_patches(pTHX) { return newSVpv(mpfr_get_patches(), 0); } SV * Rmpfr_get_emin_min(pTHX) { return newSViv(mpfr_get_emin_min()); } SV * Rmpfr_get_emin_max(pTHX) { return newSViv(mpfr_get_emin_max()); } SV * Rmpfr_get_emax_min(pTHX) { return newSViv(mpfr_get_emax_min()); } SV * Rmpfr_get_emax_max(pTHX) { return newSViv(mpfr_get_emax_max()); } void Rmpfr_clear_erangeflag(void) { mpfr_clear_erangeflag(); } int Rmpfr_erangeflag_p(void) { return mpfr_erangeflag_p(); } SV * Rmpfr_rint_round(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_rint_round(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_rint_trunc(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_rint_trunc(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_rint_ceil(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_rint_ceil(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_rint_floor(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_rint_floor(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_get_ui(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSVuv(mpfr_get_ui(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_get_si(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_get_si(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_get_uj(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE #ifdef MATH_MPFR_NEED_LONG_LONG_INT return newSVuv(mpfr_get_uj(*a, (mp_rnd_t)SvUV(round))); #else croak ("Rmpfr_get_uj not implemented on this build of perl"); #endif } SV * Rmpfr_get_sj(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE #ifdef MATH_MPFR_NEED_LONG_LONG_INT return newSViv(mpfr_get_sj(*a, (mp_rnd_t)SvUV(round))); #else croak ("Rmpfr_get_sj not implemented on this build of perl"); #endif } SV * Rmpfr_get_IV(pTHX_ mpfr_t * x, SV * round) { CHECK_ROUNDING_VALUE if(sizeof(IV) == sizeof(long)) return newSViv(mpfr_get_si(*x, (mp_rnd_t)SvUV(round))); #if defined MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(sizeof(IV) == sizeof(intmax_t)) return newSViv(mpfr_get_sj(*x, (mp_rnd_t)SvUV(round))); #else if(sizeof(IV) == sizeof(signed __int64)) return newSViv(mpfr_get_sj(*x, (mp_rnd_t)SvUV(round))); #endif #endif croak("Rmpfr_get_IV not implemented on this build of perl"); } SV * Rmpfr_get_UV(pTHX_ mpfr_t * x, SV * round) { CHECK_ROUNDING_VALUE if(sizeof(UV) == sizeof(unsigned long)) return newSVuv(mpfr_get_ui(*x, (mp_rnd_t)SvUV(round))); #if defined MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(sizeof(UV) == sizeof(uintmax_t)) return newSVuv(mpfr_get_uj(*x, (mp_rnd_t)SvUV(round))); #else if(sizeof(UV) == sizeof(unsigned __int64)) return newSVuv(mpfr_get_uj(*x, (mp_rnd_t)SvUV(round))); #endif #endif croak("Rmpfr_get_UV not implemented on this build of perl"); } SV * Rmpfr_get_NV(pTHX_ mpfr_t * x, SV * round) { CHECK_ROUNDING_VALUE #if defined(CAN_PASS_FLOAT128) return newSVnv(mpfr_get_float128(*x, (mp_rnd_t)SvUV(round))); #elif defined(USE_LONG_DOUBLE) return newSVnv(mpfr_get_ld(*x, (mp_rnd_t)SvUV(round))); #else return newSVnv(mpfr_get_d(*x, (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_fits_ulong_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_ulong_p(*a, (mp_rnd_t)SvUV(round))); #else if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*a, -0.5) >= 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*a, -1.0) > 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_ulong_p(*a, (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_fits_slong_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSVuv(mpfr_fits_slong_p(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fits_ushort_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_ushort_p(*a, (mp_rnd_t)SvUV(round))); #else if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*a, -0.5) >= 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*a, -1.0) > 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_ushort_p(*a, (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_fits_sshort_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSVuv(mpfr_fits_sshort_p(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fits_uint_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_uint_p(*a, (mp_rnd_t)SvUV(round))); #else if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*a, -0.5) >= 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*a, -1.0) > 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_uint_p(*a, (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_fits_sint_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSVuv(mpfr_fits_sint_p(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fits_uintmax_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_uintmax_p(*a, (mp_rnd_t)SvUV(round))); #else if(mpfr_zero_p(*a)) return newSVuv(1); if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*a, -0.5) >= 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*a, -1.0) > 0) && (mpfr_cmp_d(*a, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_uintmax_p(*a, (mp_rnd_t)SvUV(round))); #endif } SV * Rmpfr_fits_intmax_p(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSVuv(mpfr_fits_intmax_p(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_fits_IV_p(pTHX_ mpfr_t * x, SV * round) { unsigned long ret = 0, bits = sizeof(IV) * 8; mpfr_t high, low, copy; CHECK_ROUNDING_VALUE if(sizeof(IV) == sizeof(long)) { if(mpfr_fits_slong_p(*x, (mp_rnd_t)SvUV(round))) return newSVuv(1); return newSVuv(0); } if(sizeof(IV) == sizeof(int)) { if(mpfr_fits_sint_p(*x, (mp_rnd_t)SvUV(round))) return newSVuv(1); return newSVuv(0); } #if defined MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(sizeof(IV) == sizeof(intmax_t)) { if(mpfr_fits_intmax_p(*x, (mp_rnd_t)SvUV(round))) return newSVuv(1); return newSVuv(0); } #else if(sizeof(IV) == sizeof(signed __int64)) { if(mpfr_fits_intmax_p(*x, (mp_rnd_t)SvUV(round))) return newSVuv(1); return newSVuv(0); } #endif #endif mpfr_init2(high, bits); mpfr_init2(low, bits); mpfr_init2(copy, bits - 1); mpfr_set_ui(high, 1, GMP_RNDN); mpfr_mul_2exp(high, high, bits - 1, GMP_RNDN); mpfr_sub_ui(high, high, 1, GMP_RNDN); mpfr_setsign(low, high, 1, GMP_RNDN); mpfr_sub_ui(low, low, 1, GMP_RNDN); mpfr_set(copy, *x, (mp_rnd_t)SvUV(round)); if(mpfr_lessequal_p(copy, high) && mpfr_greaterequal_p(copy, low)) ret = 1; mpfr_clear(high); mpfr_clear(low); mpfr_clear(copy); return newSVuv(ret); } SV * Rmpfr_fits_UV_p(pTHX_ mpfr_t * x, SV * round) { unsigned long ret = 0, bits = sizeof(UV) * 8; mpfr_t high, copy; CHECK_ROUNDING_VALUE if(sizeof(UV) == sizeof(unsigned long)) { #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_ulong_p(*x, (mp_rnd_t)SvUV(round))); #else /* MPFR_VERSION unsatisfied */ if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*x, -0.5) >= 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*x, -1.0) > 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_ulong_p(*x, (mp_rnd_t)SvUV(round))); #endif /* MPFR_VERSION */ } if(sizeof(UV) == sizeof(unsigned int)) { #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_uint_p(*x, (mp_rnd_t)SvUV(round))); #else /* MPFR_VERSION unsatisfied */ if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*x, -0.5) >= 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*x, -1.0) > 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_uint_p(*x, (mp_rnd_t)SvUV(round))); #endif /* MPFR_VERSION */ } #if defined MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(sizeof(UV) == sizeof(uintmax_t)) { #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_uintmax_p(*x, (mp_rnd_t)SvUV(round))); #else /* MPFR_VERSION unsatisfied */ if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*x, -0.5) >= 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*x, -1.0) > 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_uintmax_p(*x, (mp_rnd_t)SvUV(round))); #endif /* MPFR_VERSION */ } #else /* _MSC_VER defined */ if(sizeof(UV) == sizeof(unsigned __int64)) { #if defined(MPFR_VERSION) && MPFR_VERSION > NEG_ZERO_BUG return newSVuv(mpfr_fits_uintmax_p(*x, (mp_rnd_t)SvUV(round))); #else /* MPFR_VERSION unsatisfied */ if((mp_rnd_t)SvUV(round) < 3) { if((mp_rnd_t)SvUV(round) == 0) { if((mpfr_cmp_d(*x, -0.5) >= 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } else { if((mpfr_cmp_d(*x, -1.0) > 0) && (mpfr_cmp_d(*x, 0.0) <= 0)) return newSVuv(1); } } return newSVuv(mpfr_fits_uintmax_p(*x, (mp_rnd_t)SvUV(round))); #endif /* MPFR_VERSION */ } #endif /* MSC_VER */ #endif /* MATH_MPFR_NEED_LONG_LONG_INT */ mpfr_init2(high, bits + 1); mpfr_init2(copy, bits); mpfr_set_ui(high, 1, GMP_RNDN); mpfr_mul_2exp(high, high, bits, GMP_RNDN); mpfr_sub_ui(high, high, 1, GMP_RNDN); mpfr_set(copy, *x, (mp_rnd_t)SvUV(round)); if(mpfr_lessequal_p(copy, high) && mpfr_cmp_ui(copy, 0) >= 0) ret = 1; mpfr_clear(high); mpfr_clear(copy); return newSVuv(ret); } SV * Rmpfr_strtofr(pTHX_ mpfr_t * a, SV * str, SV * base, SV * round) { int b = (int)SvIV(base); /* char ** endptr; */ #if MPFR_VERSION_MAJOR < 3 CHECK_ROUNDING_VALUE if(b < 0 || b > MAXIMUM_ALLOWABLE_BASE || b == 1) croak("3rd argument supplied to Rmpfr_strtofr is out of allowable range"); #else if(b < 0 || b > 62 || b == 1) croak("3rd argument supplied to Rmpfr_strtofr is out of allowable range"); #endif return newSViv(mpfr_strtofr(*a, SvPV_nolen(str), NULL, b, (mp_rnd_t)SvUV(round))); } void Rmpfr_set_erangeflag(void) { mpfr_set_erangeflag(); } void Rmpfr_set_underflow(void) { mpfr_set_underflow(); } void Rmpfr_set_overflow(void) { mpfr_set_overflow(); } void Rmpfr_set_nanflag(void) { mpfr_set_nanflag(); } void Rmpfr_set_inexflag(void) { mpfr_set_inexflag(); } SV * Rmpfr_erfc(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_erfc(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_j0(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_j0(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_j1(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_j1(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_jn(pTHX_ mpfr_t * a, SV * n, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_jn(*a, (long)SvIV(n), *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_y0(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_y0(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_y1(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_y1(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_yn(pTHX_ mpfr_t * a, SV * n, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_yn(*a, (long)SvIV(n), *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_atan2(pTHX_ mpfr_t * a, mpfr_t * b, mpfr_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_atan2(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_pow_z(pTHX_ mpfr_t * a, mpfr_t * b, mpz_t * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_pow_z(*a, *b, *c, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_subnormalize(pTHX_ mpfr_t * a, SV * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_subnormalize(*a, (int)SvIV(b), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_const_catalan(pTHX_ mpfr_t * a, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_const_catalan(*a, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_sec(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sec(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_csc(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_csc(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_cot(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_cot(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_root(pTHX_ mpfr_t * a, mpfr_t * b, SV * c, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_root(*a, *b, (unsigned long)SvUV(c), (mp_rnd_t)SvUV(round))); } SV * Rmpfr_eint(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_eint(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_li2(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_li2(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_get_f(pTHX_ mpf_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_get_f(*a, *b, (mp_rnd_t)SvUV(round))); } /* No need for rounding as result will be exact */ void Rmpfr_get_q(mpq_t * a, mpfr_t * b) { mpf_t temp; if(!mpfr_number_p(*b)) { mpq_set_ui(*a, 0, 1); mpfr_set_erangeflag(); } else { mpf_init2 (temp, (mp_bitcnt_t)mpfr_get_prec(*b)); mpfr_get_f(temp, *b, GMP_RNDN); mpq_set_f (*a, temp); mpf_clear(temp); } } SV * Rmpfr_sech(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_sech(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_csch(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_csch(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_coth(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE return newSViv(mpfr_coth(*a, *b, (mp_rnd_t)SvUV(round))); } SV * Rmpfr_lngamma(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { CHECK_ROUNDING_VALUE #if !defined(MPFR_VERSION) || (defined(MPFR_VERSION) && MPFR_VERSION <= LNGAMMA_BUG) if(!mpfr_nan_p(*b) && mpfr_sgn(*b) <= 0) { mpfr_set_inf(*a, 1); return newSViv(0); } #endif return newSViv(mpfr_lngamma(*a, *b, (mp_rnd_t)SvUV(round))); } void Rmpfr_lgamma(pTHX_ mpfr_t * a, mpfr_t * b, SV * round) { dXSARGS; int ret, signp; CHECK_ROUNDING_VALUE ret = mpfr_lgamma(*a, &signp, *b, (mp_rnd_t)SvUV(round)); ST(0) = sv_2mortal(newSViv(signp)); ST(1) = sv_2mortal(newSViv(ret)); XSRETURN(2); } SV * _MPFR_VERSION(pTHX) { #if defined(MPFR_VERSION) return newSVuv(MPFR_VERSION); #else return &PL_sv_undef; #endif } SV * _MPFR_VERSION_MAJOR(pTHX) { return newSVuv(MPFR_VERSION_MAJOR); } SV * _MPFR_VERSION_MINOR(pTHX) { return newSVuv(MPFR_VERSION_MINOR); } SV * _MPFR_VERSION_PATCHLEVEL(pTHX) { return newSVuv(MPFR_VERSION_PATCHLEVEL); } SV * _MPFR_VERSION_STRING(pTHX) { return newSVpv(MPFR_VERSION_STRING, 0); } SV * RMPFR_VERSION_NUM(pTHX_ SV * a, SV * b, SV * c) { return newSVuv(MPFR_VERSION_NUM((unsigned long)SvUV(a), (unsigned long)SvUV(b), (unsigned long)SvUV(c))); } SV * Rmpfr_sum(pTHX_ mpfr_t * rop, SV * avref, SV * len, SV * round) { mpfr_ptr *p; SV ** elem; int ret, i; unsigned long s = (unsigned long)SvUV(len); if(s > av_len((AV*)SvRV(avref)) + 1)croak("2nd last arg (%d) needs to be between 0 and %d (inclusive)", s, av_len((AV*)SvRV(avref)) + 1); CHECK_ROUNDING_VALUE Newx(p, s, mpfr_ptr); if(p == NULL) croak("Unable to allocate memory in Rmpfr_sum"); for(i = 0; i < s; ++i) { elem = av_fetch((AV*)SvRV(avref), i, 0); p[i] = (INT2PTR(mpfr_t *, SvIV(SvRV(*elem))))[0]; } ret = mpfr_sum(*rop, p, s, (mp_rnd_t)SvUV(round)); Safefree(p); return newSVuv(ret); } SV * overload_mul(pTHX_ SV * a, SV * b, SV * third) { mpfr_t * mpfr_t_obj, t; SV * obj_ref, * obj; int ret; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_mul function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(SvIOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded multiplication (*) contains non-numeric characters"); } mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } #endif #else if(SvUOK(b)) { mpfr_mul_ui(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return obj_ref; } if(SvIOK(b)) { mpfr_mul_si(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else mpfr_mul_d(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), (double)SvNV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvPOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded multiplication (*) contains non-numeric characters"); } mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPz")) { mpfr_mul_z(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPq")) { mpfr_mul_q(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); mpfr_mul(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } } croak("Invalid argument supplied to Math::MPFR::overload_mul"); } SV * overload_add(pTHX_ SV * a, SV * b, SV * third) { mpfr_t * mpfr_t_obj, t; SV * obj_ref, * obj; int ret; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_add function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(SvIOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded addition (+) contains non-numeric characters"); } mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } #endif #else if(SvUOK(b)) { mpfr_add_ui(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return obj_ref; } if(SvIOK(b)) { mpfr_add_si(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else mpfr_add_d(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), (double)SvNV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvPOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded addition (+) contains non-numeric characters"); } mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPz")) { mpfr_add_z(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPq")) { mpfr_add_q(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); mpfr_add(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } } croak("Invalid argument supplied to Math::MPFR::overload_add"); } SV * overload_sub(pTHX_ SV * a, SV * b, SV * third) { mpfr_t * mpfr_t_obj, t; SV * obj_ref, * obj; int ret; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_sub function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(SvIOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded subtraction (-) contains non-numeric characters"); } if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } #endif #else if(SvUOK(b)) { if(third == &PL_sv_yes) mpfr_ui_sub(*mpfr_t_obj, SvUV(b), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub_ui(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return obj_ref; } if(SvIOK(b)) { if(third == &PL_sv_yes) mpfr_si_sub(*mpfr_t_obj, SvIV(b), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub_si(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(third == &PL_sv_yes) mpfr_d_sub(*mpfr_t_obj, SvNV(b), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub_d(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvNV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvPOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("2string used in overloaded subtraction (-) contains non-numeric characters"); } if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPz")) { mpfr_sub_z(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_neg(*mpfr_t_obj, *mpfr_t_obj, GMP_RNDN); return obj_ref; } if(strEQ(h, "Math::GMPq")) { mpfr_sub_q(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_neg(*mpfr_t_obj, *mpfr_t_obj, GMP_RNDN); return obj_ref; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_sub(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_sub(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } } croak("Invalid argument supplied to Math::MPFR::overload_sub function"); } SV * overload_div(pTHX_ SV * a, SV * b, SV * third) { mpfr_t * mpfr_t_obj, t; SV * obj_ref, * obj; int ret; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_div function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(SvIOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded division (/) contains non-numeric characters"); } if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } #endif #else if(SvUOK(b)) { if(third == &PL_sv_yes) mpfr_ui_div(*mpfr_t_obj, SvUV(b), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div_ui(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return obj_ref; } if(SvIOK(b)) { if(third == &PL_sv_yes) mpfr_si_div(*mpfr_t_obj, SvIV(b), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div_si(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); return obj_ref; mpfr_clear(t); } #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(third == &PL_sv_yes) mpfr_d_div(*mpfr_t_obj, SvNV(b), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div_d(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvNV(b), __gmpfr_default_rounding_mode); return obj_ref; } #endif if(SvPOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded division (/) contains non-numeric characters"); } if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPz")) { mpfr_div_z(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); /* *mpfr_t_obj gets rounded a second time if third == &PL_sv_yes */ if(third == &PL_sv_yes) mpfr_ui_div(*mpfr_t_obj, 1, *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPq")) { mpfr_div_q(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t * , SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); /* *mpfr_t_obj gets rounded a second time if third == &PL_sv_yes */ if(third == &PL_sv_yes) mpfr_ui_div(*mpfr_t_obj, 1, *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_div(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); else mpfr_div(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } } croak("Invalid argument supplied to Math::MPFR::overload_div function"); } SV * overload_copy(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_copy function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init2(*mpfr_t_obj, mpfr_get_prec(*p)); mpfr_set(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_abs(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_abs function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); mpfr_abs(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_gt(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)){ mpfr_set_erangeflag(); return newSVuv(0); } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (>) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return newSVuv(0); } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (>) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret > 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { return newSVuv(mpfr_greater_p(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))); } } croak("Invalid argument supplied to Math::MPFR::overload_gt"); } SV * overload_gte(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)){ mpfr_set_erangeflag(); return newSVuv(0); } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (>=) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return newSVuv(0); } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (>=) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret >= 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { return newSVuv(mpfr_greaterequal_p(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))); } } croak("Invalid argument supplied to Math::MPFR::overload_gte"); } SV * overload_lt(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)){ mpfr_set_erangeflag(); return newSVuv(0); } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (<) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return newSVuv(0); } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (<) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { return newSVuv(mpfr_less_p(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))); } } croak("Invalid argument supplied to Math::MPFR::overload_lt"); } SV * overload_lte(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)){ mpfr_set_erangeflag(); return newSVuv(0); } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (<=) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return newSVuv(0); } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (<=) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret <= 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) return newSVuv(mpfr_lessequal_p(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))); } croak("Invalid argument supplied to Math::MPFR::overload_lte"); } SV * overload_spaceship(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)) { mpfr_set_erangeflag(); return &PL_sv_undef; } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (<=>) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return &PL_sv_undef; } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (<=>) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(third == &PL_sv_yes) ret *= -1; if(ret < 0) return newSViv(-1); if(ret > 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { return newSViv(mpfr_cmp(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))); } } croak("Invalid argument supplied to Math::MPFR::overload_spaceship"); } SV * overload_equiv(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)){ mpfr_set_erangeflag(); return newSVuv(0); } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret == 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret == 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, (char *)SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (==) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret == 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(ret == 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(ret == 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return newSVuv(0); } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(ret == 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, (char *)SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (==) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret == 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { return newSVuv(mpfr_equal_p(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))); } } croak("Invalid argument supplied to Math::MPFR::overload_equiv"); } SV * overload_not_equiv(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t t; int ret; if(mpfr_nan_p(*a)){ mpfr_set_erangeflag(); return newSVuv(1); } #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret != 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret != 0) return newSViv(1); return newSViv(0); } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, (char *)SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (!=) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret != 0) return newSViv(1); return newSViv(0); } #endif #else if(SvUOK(b)) { ret = mpfr_cmp_ui(*a, SvUV(b)); if(ret != 0) return newSViv(1); return newSViv(0); } if(SvIOK(b)) { ret = mpfr_cmp_si(*a, SvIV(b)); if(ret != 0) return newSViv(1); return newSViv(0); } #endif if(SvNOK(b)) { if(SvNV(b) != SvNV(b)) { /* it's a NaN */ mpfr_set_erangeflag(); return newSVuv(1); } #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); ret = mpfr_cmp(*a, t); mpfr_clear(t); #elif defined(USE_LONG_DOUBLE) ret = mpfr_cmp_ld(*a, (long double)SvNV(b)); #else ret = mpfr_cmp_d(*a, (double)SvNV(b)); #endif if(ret != 0) return newSViv(1); return newSViv(0); } if(SvPOK(b)) { ret = mpfr_init_set_str(t, (char *)SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded comparison (!=) contains non-numeric characters"); } ret = mpfr_cmp(*a, t); mpfr_clear(t); if(ret != 0) return newSViv(1); return newSViv(0); } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { if(mpfr_equal_p(*a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))))) return newSViv(0); return newSViv(1); } } croak("Invalid argument supplied to Math::MPFR::overload_not_equiv"); } SV * overload_true(pTHX_ mpfr_t *a, SV *second, SV * third) { if(mpfr_nan_p(*a)) return newSVuv(0); if(mpfr_cmp_ui(*a, 0)) return newSVuv(1); return newSVuv(0); } SV * overload_not(pTHX_ mpfr_t * a, SV * second, SV * third) { if(mpfr_nan_p(*a)) return newSViv(1); if(mpfr_cmp_ui(*a, 0)) return newSViv(0); return newSViv(1); } SV * overload_sqrt(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_sqrt function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); /* No - this was wrong. If a negative value is supplied, a NaN should be returned instad */ /* if(mpfr_cmp_ui(*p, 0) < 0) croak("Negative value supplied as argument to overload_sqrt"); */ mpfr_sqrt(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_pow(pTHX_ SV * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj, t; SV * obj_ref, * obj; int ret; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_pow function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(second)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(second), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } if(SvIOK(second)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(second), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } #else if(SvIOK(second)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(second), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded exponentiation (**) contains non-numeric characters"); } if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } #endif #else if(SvUOK(second)) { if(third == &PL_sv_yes) mpfr_ui_pow(*mpfr_t_obj, SvUV(second), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow_ui(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), SvUV(second), __gmpfr_default_rounding_mode); return obj_ref; } if(SvIOK(second)) { /* Need to do it this way as there's no mpfr_si_pow function */ if(SvIV(second) >= 0) { if(third == &PL_sv_yes) mpfr_ui_pow(*mpfr_t_obj, SvUV(second), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow_ui(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), SvUV(second), __gmpfr_default_rounding_mode); return obj_ref; } if(third != &PL_sv_yes) { mpfr_pow_si(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), SvIV(second), __gmpfr_default_rounding_mode); return obj_ref; } } #endif if(SvNOK(second)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(second), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(second), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_set_d(t, (double)SvNV(second), __gmpfr_default_rounding_mode); #endif if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } if(SvPOK(second)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(second), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded exponentaition (**) contains non-numeric characters"); } if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(sv_isobject(second)) { const char* h = HvNAME(SvSTASH(SvRV(second))); if(strEQ(h, "Math::MPFR")) { mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPz")) { if(third == &PL_sv_yes) { mpfr_init2(t, (mpfr_prec_t)mpz_sizeinbase(*(INT2PTR(mpz_t *, SvIV(SvRV(second)))), 2)); mpfr_set_z(t, *(INT2PTR(mpz_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); mpfr_pow(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); mpfr_clear(t); } else mpfr_pow_z(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p )))), *(INT2PTR(mpz_t * , SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPq")) { mpfr_set_q(*mpfr_t_obj, *(INT2PTR(mpq_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, *mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *mpfr_t_obj, __gmpfr_default_rounding_mode); return obj_ref; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(second)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes) mpfr_pow(*mpfr_t_obj, t, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), __gmpfr_default_rounding_mode); else mpfr_pow(*mpfr_t_obj, *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return obj_ref; } } croak("Invalid argument supplied to Math::MPFR::overload_pow."); } SV * overload_log(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_log function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); mpfr_log(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_exp(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_exp function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); mpfr_exp(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_sin(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_sin function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); mpfr_sin(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_cos(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_cos function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); mpfr_cos(*mpfr_t_obj, *p, __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_int(pTHX_ mpfr_t * p, SV * second, SV * third) { mpfr_t * mpfr_t_obj; SV * obj_ref, * obj; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_int function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); mpfr_trunc(*mpfr_t_obj, *p); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } SV * overload_atan2(pTHX_ mpfr_t * a, SV * b, SV * third) { mpfr_t * mpfr_t_obj, t; SV * obj_ref, * obj; int ret; Newx(mpfr_t_obj, 1, mpfr_t); if(mpfr_t_obj == NULL) croak("Failed to allocate memory in overload_atan2 function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR"); mpfr_init(*mpfr_t_obj); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, t, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, t, __gmpfr_default_rounding_mode); } sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); mpfr_clear(t); SvREADONLY_on(obj); return obj_ref; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, t, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, t, __gmpfr_default_rounding_mode); } mpfr_clear(t); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } #else if(SvIOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded atan2 contains non-numeric characters"); } if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, *mpfr_t_obj, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, *mpfr_t_obj, __gmpfr_default_rounding_mode); } sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } #endif #else if(SvUOK(b)) { mpfr_init2(t, 8 * sizeof(long)); mpfr_set_ui(t, SvUV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, t, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, t, __gmpfr_default_rounding_mode); } mpfr_clear(t); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } if(SvIOK(b)) { mpfr_init2(t, 8 * sizeof(long)); mpfr_set_si(t, SvIV(b), __gmpfr_default_rounding_mode); if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, t, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, t, __gmpfr_default_rounding_mode); } mpfr_clear(t); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_set_d(t, (double)SvNV(b), __gmpfr_default_rounding_mode); #endif if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, t, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, t, __gmpfr_default_rounding_mode); } mpfr_clear(t); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } if(SvPOK(b)) { ret = mpfr_set_str(*mpfr_t_obj, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded atan2 contains non-numeric characters"); } if(third == &PL_sv_yes){ mpfr_atan2(*mpfr_t_obj, *mpfr_t_obj, *a, __gmpfr_default_rounding_mode); } else { mpfr_atan2(*mpfr_t_obj, *a, *mpfr_t_obj, __gmpfr_default_rounding_mode); } sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_atan2(*mpfr_t_obj, *a, *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); sv_setiv(obj, INT2PTR(IV,mpfr_t_obj)); SvREADONLY_on(obj); return obj_ref; } } croak("Invalid argument supplied to Math::MPFR::overload_atan2 function"); } /* Finish typemapping */ SV * Rmpfr_randinit_default_nobless(pTHX) { gmp_randstate_t * state; SV * obj_ref, * obj; Newx(state, 1, gmp_randstate_t); if(state == NULL) croak("Failed to allocate memory in Rmpfr_randinit_default function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); gmp_randinit_default(*state); sv_setiv(obj, INT2PTR(IV,state)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_randinit_mt_nobless(pTHX) { gmp_randstate_t * rand_obj; SV * obj_ref, * obj; Newx(rand_obj, 1, gmp_randstate_t); if(rand_obj == NULL) croak("Failed to allocate memory in Math::GMPz::Random::Rmpfr_randinit_mt function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); gmp_randinit_mt(*rand_obj); sv_setiv(obj, INT2PTR(IV, rand_obj)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_randinit_lc_2exp_nobless(pTHX_ SV * a, SV * c, SV * m2exp ) { gmp_randstate_t * state; mpz_t aa; SV * obj_ref, * obj; Newx(state, 1, gmp_randstate_t); if(state == NULL) croak("Failed to allocate memory in Rmpfr_randinit_lc_2exp function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); if(sv_isobject(a)) { const char* h = HvNAME(SvSTASH(SvRV(a))); if(strEQ(h, "Math::GMP") || strEQ(h, "GMP::Mpz") || strEQ(h, "Math::GMPz")) gmp_randinit_lc_2exp(*state, *(INT2PTR(mpz_t *, SvIV(SvRV(a)))), (unsigned long)SvUV(c), (unsigned long)SvUV(m2exp)); else croak("First arg to Rmpfr_randinit_lc_2exp is of invalid type"); } else { if(!mpz_init_set_str(aa, SvPV_nolen(a), 0)) { gmp_randinit_lc_2exp(*state, aa, (unsigned long)SvUV(c), (unsigned long)SvUV(m2exp)); mpz_clear(aa); } else croak("Seedstring supplied to Rmpfr_randinit_lc_2exp is not a valid number"); } sv_setiv(obj, INT2PTR(IV,state)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_randinit_lc_2exp_size_nobless(pTHX_ SV * size) { gmp_randstate_t * state; SV * obj_ref, * obj; if(SvUV(size) > 128) croak("The argument supplied to Rmpfr_randinit_lc_2exp_size function (%u) needs to be in the range [1..128]", SvUV(size)); Newx(state, 1, gmp_randstate_t); if(state == NULL) croak("Failed to allocate memory in Rmpfr_randinit_lc_2exp_size function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, NULL); if(gmp_randinit_lc_2exp_size(*state, (unsigned long)SvUV(size))) { sv_setiv(obj, INT2PTR(IV,state)); SvREADONLY_on(obj); return obj_ref; } croak("Rmpfr_randinit_lc_2exp_size function failed"); } void Rmpfr_randclear(pTHX_ SV * p) { gmp_randclear(*(INT2PTR(gmp_randstate_t *, SvIV(SvRV(p))))); Safefree(INT2PTR(gmp_randstate_t *, SvIV(SvRV(p)))); } void Rmpfr_randseed(pTHX_ SV * state, SV * seed) { mpz_t s; if(sv_isobject(seed)) { const char* h = HvNAME(SvSTASH(SvRV(seed))); if(strEQ(h, "Math::GMP") || strEQ(h, "GMP::Mpz") || strEQ(h, "Math::GMPz")) gmp_randseed(*(INT2PTR(gmp_randstate_t *, SvIV(SvRV(state)))), *(INT2PTR(mpz_t *, SvIV(SvRV(seed))))); else croak("2nd arg to Rmpfr_randseed is of invalid type"); } else { if(!mpz_init_set_str(s, SvPV_nolen(seed), 0)) { gmp_randseed(*(INT2PTR(gmp_randstate_t *, SvIV(SvRV(state)))), s); mpz_clear(s); } else croak("Seedstring supplied to Rmpfr_randseed is not a valid number"); } } void Rmpfr_randseed_ui(pTHX_ SV * state, SV * seed) { gmp_randseed_ui(*(INT2PTR(gmp_randstate_t *, SvIV(SvRV(state)))), (unsigned long)SvUV(seed)); } SV * overload_pow_eq(pTHX_ SV * p, SV * second, SV * third) { mpfr_t t; int ret; SvREFCNT_inc(p); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(second)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(second), __gmpfr_default_rounding_mode); mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } if(SvIOK(second)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(second), __gmpfr_default_rounding_mode); mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } #else if(SvIOK(second)) { ret = mpfr_init_set_str(t, SvPV_nolen(second), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded exponentiation (**=) contains non-numeric characters"); } mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } #endif #else if(SvUOK(second)) { mpfr_pow_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), SvUV(second), __gmpfr_default_rounding_mode); return p; } if(SvIOK(second)) { /* if(SvIV(second) >= 0) { mpfr_pow_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), SvUV(second), __gmpfr_default_rounding_mode); return p; } */ mpfr_pow_si(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), SvIV(second), __gmpfr_default_rounding_mode); return p; } #endif if(SvNOK(second)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(second), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(second), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_set_d(t, (double)SvNV(second), __gmpfr_default_rounding_mode); #endif mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } if(SvPOK(second)) { ret = mpfr_init_set_str(t, SvPV_nolen(second), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded exponentiation (**=) contains non-numeric characters"); } mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } if(sv_isobject(second)) { const char* h = HvNAME(SvSTASH(SvRV(second))); if(strEQ(h, "Math::MPFR")) { mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); return p; } if(strEQ(h, "Math::GMPz")) { mpfr_pow_z(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpz_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); return p; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(second)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } if(strEQ(h, "Math::GMPq")) { mpfr_init(t); mpfr_set_q(t, *(INT2PTR(mpq_t *, SvIV(SvRV(second)))), __gmpfr_default_rounding_mode); mpfr_pow(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return p; } } SvREFCNT_dec(p); croak("Invalid argument supplied to Math::MPFR::overload_pow_eq."); } SV * overload_div_eq(pTHX_ SV * a, SV * b, SV * third) { mpfr_t t; int ret; SvREFCNT_inc(a); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded division (/=) contains non-numeric characters"); } mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #endif #else if(SvUOK(b)) { mpfr_div_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } if(SvIOK(b)) { mpfr_div_si(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return a; /* if(SvIV(b) >= 0) { mpfr_div_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } mpfr_div_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b) * -1, __gmpfr_default_rounding_mode); mpfr_neg(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); return a; */ } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_set_d(t, (double)SvNV(b), __gmpfr_default_rounding_mode); #endif mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded division (/=) contains non-numeric characters"); } mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPz")) { mpfr_div_z(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); mpfr_div(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(strEQ(h, "Math::GMPq")) { mpfr_div_q(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } } SvREFCNT_dec(a); croak("Invalid argument supplied to Math::MPFR::overload_div_eq function"); } SV * overload_sub_eq(pTHX_ SV * a, SV * b, SV * third) { mpfr_t t; int ret; SvREFCNT_inc(a); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded subtraction (-=) contains non-numeric characters"); } mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #endif #else if(SvUOK(b)) { mpfr_sub_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } if(SvIOK(b)) { mpfr_sub_si(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return a; /* if(SvIV(b) >= 0) { mpfr_sub_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } mpfr_add_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b) * -1, __gmpfr_default_rounding_mode); return a; */ } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_init_set_d(t, (double)SvNV(b), __gmpfr_default_rounding_mode); #endif mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded subtraction (-=) contains non-numeric characters"); } mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPz")) { mpfr_sub_z(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); mpfr_sub(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(strEQ(h, "Math::GMPq")) { mpfr_sub_q(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } } SvREFCNT_dec(a); croak("Invalid argument supplied to Math::MPFR::overload_sub_eq function"); } SV * overload_add_eq(pTHX_ SV * a, SV * b, SV * third) { mpfr_t t; int ret; SvREFCNT_inc(a); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded addition (+=) contains non-numeric characters"); } mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #endif #else if(SvUOK(b)) { mpfr_add_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } if(SvIOK(b)) { mpfr_add_si(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return a; /* if(SvIV(b) >= 0) { mpfr_add_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } mpfr_sub_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b) * -1, __gmpfr_default_rounding_mode); return a; */ } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_set_d(t, (double)SvNV(b), __gmpfr_default_rounding_mode); #endif mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded addition (+=) contains non-numeric characters"); } mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPz")) { mpfr_add_z(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); mpfr_add(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(strEQ(h, "Math::GMPq")) { mpfr_add_q(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } } SvREFCNT_dec(a); croak("Invalid argument supplied to Math::MPFR::overload_add_eq"); } SV * overload_mul_eq(pTHX_ SV * a, SV * b, SV * third) { mpfr_t t; int ret; SvREFCNT_inc(a); #ifdef MATH_MPFR_NEED_LONG_LONG_INT #ifndef _MSC_VER if(SvUOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_uj(t, SvUV(b), __gmpfr_default_rounding_mode); mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvIOK(b)) { mpfr_init2(t, (mpfr_prec_t)IVSIZE_BITS); mpfr_set_sj(t, SvIV(b), __gmpfr_default_rounding_mode); mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #else if(SvIOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 10, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded multiplication (*=) contains non-numeric characters"); } mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } #endif #else if(SvUOK(b)) { mpfr_mul_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } if(SvIOK(b)) { mpfr_mul_si(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b), __gmpfr_default_rounding_mode); return a; /* if(SvIV(b) >= 0) { mpfr_mul_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvUV(b), __gmpfr_default_rounding_mode); return a; } mpfr_mul_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), SvIV(b) * -1, __gmpfr_default_rounding_mode); mpfr_neg(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), __gmpfr_default_rounding_mode); return a; */ } #endif if(SvNOK(b)) { #if defined(CAN_PASS_FLOAT128) mpfr_init2(t, FLT128_MANT_DIG); mpfr_set_float128(t, (float128)SvNV(b), __gmpfr_default_rounding_mode); #elif defined(USE_LONG_DOUBLE) mpfr_init2(t, REQUIRED_LDBL_MANT_DIG); mpfr_set_ld(t, (long double)SvNV(b), __gmpfr_default_rounding_mode); #else mpfr_init2(t, DBL_MANT_DIG); mpfr_init_set_d(t, (double)SvNV(b), __gmpfr_default_rounding_mode); #endif mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(SvPOK(b)) { ret = mpfr_init_set_str(t, SvPV_nolen(b), 0, __gmpfr_default_rounding_mode); if(ret) { nnum++; if(SvIV(get_sv("Math::MPFR::NNW", 0))) warn("string used in overloaded multiplication (*=) contains non-numeric characters"); } mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPz")) { mpfr_mul_z(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpz_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } if(strEQ(h, "Math::GMPf")) { mpfr_init2(t, (mpfr_prec_t)mpf_get_prec(*(INT2PTR(mpf_t *, SvIV(SvRV(b)))))); mpfr_set_f(t, *(INT2PTR(mpf_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); mpfr_mul(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), t, __gmpfr_default_rounding_mode); mpfr_clear(t); return a; } if(strEQ(h, "Math::GMPq")) { mpfr_mul_q(*(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(a)))), *(INT2PTR(mpq_t *, SvIV(SvRV(b)))), __gmpfr_default_rounding_mode); return a; } } SvREFCNT_dec(a); croak("Invalid argument supplied to Math::MPFR::overload_mul_eq"); } SV * _itsa(pTHX_ SV * a) { if(SvUOK(a)) return newSVuv(1); if(SvIOK(a)) return newSVuv(2); if(SvNOK(a)) return newSVuv(3); if(SvPOK(a)) return newSVuv(4); if(sv_isobject(a)) { const char* h = HvNAME(SvSTASH(SvRV(a))); if(strEQ(h, "Math::MPFR")) return newSVuv(5); if(strEQ(h, "Math::GMPf")) return newSVuv(6); if(strEQ(h, "Math::GMPq")) return newSVuv(7); if(strEQ(h, "Math::GMPz")) return newSVuv(8); if(strEQ(h, "Math::GMP")) return newSVuv(9); } return newSVuv(0); } int _has_longlong(void) { #ifdef MATH_MPFR_NEED_LONG_LONG_INT return 1; #else return 0; #endif } int _has_longdouble(void) { #ifdef USE_LONG_DOUBLE return 1; #else return 0; #endif } int _ivsize_bits(void) { int ret = 0; #ifdef IVSIZE_BITS ret = IVSIZE_BITS; #endif return ret; } /* int _mpfr_longsize(void) { mpfr_t x, y; mpfr_init2(x, 100); mpfr_init2(y, 100); mpfr_set_str(x, "18446744073709551615", 10, GMP_RNDN); mpfr_set_ui(y, 18446744073709551615, GMP_RNDN); if(!mpfr_cmp(x,y)) return 64; return 32; } */ SV * RMPFR_PREC_MAX(pTHX) { return newSViv(MPFR_PREC_MAX); } SV * RMPFR_PREC_MIN(pTHX) { return newSViv(MPFR_PREC_MIN); } SV * wrap_mpfr_printf(pTHX_ SV * a, SV * b) { int ret; if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")){ ret = mpfr_printf(SvPV_nolen(a), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); fflush(stdout); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")){ ret = mpfr_printf(SvPV_nolen(a), *(INT2PTR(mp_prec_t *, SvIV(SvRV(b))))); fflush(stdout); return newSViv(ret); } croak("Unrecognised object supplied as argument to Rmpfr_printf"); } if(SvUOK(b)) { ret = mpfr_printf(SvPV_nolen(a), SvUV(b)); fflush(stdout); return newSViv(ret); } if(SvIOK(b)) { ret = mpfr_printf(SvPV_nolen(a), SvIV(b)); fflush(stdout); return newSViv(ret); } if(SvNOK(b)) { ret = mpfr_printf(SvPV_nolen(a), SvNV(b)); fflush(stdout); return newSViv(ret); } if(SvPOK(b)) { ret = mpfr_printf(SvPV_nolen(a), SvPV_nolen(b)); fflush(stdout); return newSViv(ret); } croak("Unrecognised type supplied as argument to Rmpfr_printf"); } SV * wrap_mpfr_fprintf(pTHX_ FILE * stream, SV * a, SV * b) { int ret; if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { ret = mpfr_fprintf(stream, SvPV_nolen(a), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); fflush(stream); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")) { ret = mpfr_fprintf(stream, SvPV_nolen(a), *(INT2PTR(mp_prec_t *, SvIV(SvRV(b))))); fflush(stream); return newSViv(ret); } croak("Unrecognised object supplied as argument to Rmpfr_fprintf"); } if(SvUOK(b)) { ret = mpfr_fprintf(stream, SvPV_nolen(a), SvUV(b)); fflush(stream); return newSViv(ret); } if(SvIOK(b)) { ret = mpfr_fprintf(stream, SvPV_nolen(a), SvIV(b)); fflush(stream); return newSViv(ret); } if(SvNOK(b)) { ret = mpfr_fprintf(stream, SvPV_nolen(a), SvNV(b)); fflush(stream); return newSViv(ret); } if(SvPOK(b)) { ret = mpfr_fprintf(stream, SvPV_nolen(a), SvPV_nolen(b)); fflush(stream); return newSViv(ret); } croak("Unrecognised type supplied as argument to Rmpfr_fprintf"); } SV * wrap_mpfr_sprintf(pTHX_ SV * s, SV * a, SV * b, int buflen) { int ret; char * stream; Newx(stream, buflen, char); if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { ret = mpfr_sprintf(stream, SvPV_nolen(a), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")) { ret = mpfr_sprintf(stream, SvPV_nolen(a), *(INT2PTR(mp_prec_t *, SvIV(SvRV(b))))); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } croak("Unrecognised object supplied as argument to Rmpfr_sprintf"); } if(SvUOK(b)) { ret = mpfr_sprintf(stream, SvPV_nolen(a), SvUV(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(SvIOK(b)) { ret = mpfr_sprintf(stream, SvPV_nolen(a), SvIV(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(SvNOK(b)) { ret = mpfr_sprintf(stream, SvPV_nolen(a), SvNV(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(SvPOK(b)) { ret = mpfr_sprintf(stream, SvPV_nolen(a), SvPV_nolen(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } croak("Unrecognised type supplied as argument to Rmpfr_sprintf"); } SV * wrap_mpfr_snprintf(pTHX_ SV * s, SV * bytes, SV * a, SV * b, int buflen) { int ret; char * stream; Newx(stream, buflen, char); if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), *(INT2PTR(mp_prec_t *, SvIV(SvRV(b))))); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } croak("Unrecognised object supplied as argument to Rmpfr_snprintf"); } if(SvUOK(b)) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), SvUV(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(SvIOK(b)) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), SvIV(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(SvNOK(b)) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), SvNV(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(SvPOK(b)) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), SvPV_nolen(b)); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } croak("Unrecognised type supplied as argument to Rmpfr_snprintf"); } SV * wrap_mpfr_printf_rnd(pTHX_ SV * a, SV * round, SV * b) { int ret; #if MPFR_VERSION_MAJOR >= 3 if((mp_rnd_t)SvUV(round) > 4) croak("Invalid 2nd argument (rounding value) of %u passed to Rmpfr_printf", (mp_rnd_t)SvUV(round)); #else if((mp_rnd_t)SvUV(round) > 3) croak("Invalid 2nd argument (rounding value) of %u passed to Rmpfr_printf", (mp_rnd_t)SvUV(round)); #endif if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")){ ret = mpfr_printf(SvPV_nolen(a), (mp_rnd_t)SvUV(round), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); fflush(stdout); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")){ croak("You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_printf"); } croak("Unrecognised object supplied as argument to Rmpfr_printf"); } croak("In Rmpfr_printf: The rounding argument is specific to Math::MPFR objects"); } SV * wrap_mpfr_fprintf_rnd(pTHX_ FILE * stream, SV * a, SV * round, SV * b) { int ret; #if MPFR_VERSION_MAJOR >= 3 if((mp_rnd_t)SvUV(round) > 4) croak("Invalid 3rd argument (rounding value) of %u passed to Rmpfr_fprintf", (mp_rnd_t)SvUV(round)); #else if((mp_rnd_t)SvUV(round) > 3) croak("Invalid 3rd argument (rounding value) of %u passed to Rmpfr_fprintf", (mp_rnd_t)SvUV(round)); #endif if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { ret = mpfr_fprintf(stream, SvPV_nolen(a), (mp_rnd_t)SvUV(round), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); fflush(stream); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")) { croak("You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_fprintf"); } croak("Unrecognised object supplied as argument to Rmpfr_fprintf"); } croak("In Rmpfr_fprintf: The rounding argument is specific to Math::MPFR objects"); } SV * wrap_mpfr_sprintf_rnd(pTHX_ SV * s, SV * a, SV * round, SV * b, int buflen) { int ret; char * stream; Newx(stream, buflen, char); #if MPFR_VERSION_MAJOR >= 3 if((mp_rnd_t)SvUV(round) > 4) croak("Invalid 3rd argument (rounding value) of %u passed to Rmpfr_sprintf", (mp_rnd_t)SvUV(round)); #else if((mp_rnd_t)SvUV(round) > 3) croak("Invalid 3rd argument (rounding value) of %u passed to Rmpfr_sprintf", (mp_rnd_t)SvUV(round)); #endif if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { ret = mpfr_sprintf(stream, SvPV_nolen(a), (mp_rnd_t)SvUV(round), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")) { croak("You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_sprintf"); } croak("Unrecognised object supplied as argument to Rmpfr_sprintf"); } croak("In Rmpfr_sprintf: The rounding argument is specific to Math::MPFR objects"); } SV * wrap_mpfr_snprintf_rnd(pTHX_ SV * s, SV * bytes, SV * a, SV * round, SV * b, int buflen) { int ret; char * stream; Newx(stream, buflen, char); #if MPFR_VERSION_MAJOR >= 3 if((mp_rnd_t)SvUV(round) > 4) croak("Invalid 3rd argument (rounding value) of %u passed to Rmpfr_snprintf", (mp_rnd_t)SvUV(round)); #else if((mp_rnd_t)SvUV(round) > 3) croak("Invalid 3rd argument (rounding value) of %u passed to Rmpfr_snprintf", (mp_rnd_t)SvUV(round)); #endif if(sv_isobject(b)) { const char* h = HvNAME(SvSTASH(SvRV(b))); if(strEQ(h, "Math::MPFR")) { ret = mpfr_snprintf(stream, (size_t)SvUV(bytes), SvPV_nolen(a), (mp_rnd_t)SvUV(round), *(INT2PTR(mpfr_t *, SvIV(SvRV(b))))); sv_setpv(s, stream); Safefree(stream); return newSViv(ret); } if(strEQ(h, "Math::MPFR::Prec")) { croak("You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_snprintf"); } croak("Unrecognised object supplied as argument to Rmpfr_snprintf"); } croak("In Rmpfr_snprintf: The rounding argument is specific to Math::MPFR objects"); } SV * Rmpfr_buildopt_tls_p(pTHX) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_buildopt_tls_p()); #else croak("Rmpfr_buildopt_tls_p not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_buildopt_decimal_p(pTHX) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_buildopt_decimal_p()); #else croak("Rmpfr_buildopt_decimal_p not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_regular_p(pTHX_ mpfr_t * a) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_regular_p(*a)); #else croak("Rmpfr_regular_p not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } void Rmpfr_set_zero(pTHX_ mpfr_t * a, SV * sign) { #if MPFR_VERSION_MAJOR >= 3 mpfr_set_zero(*a, (int)SvIV(sign)); #else croak("Rmpfr_set_zero not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_digamma(pTHX_ mpfr_t * rop, mpfr_t * op, SV * round) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_digamma(*rop, *op, (mp_rnd_t)SvIV(round))); #else croak("Rmpfr_digamma not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_ai(pTHX_ mpfr_t * rop, mpfr_t * op, SV * round) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_ai(*rop, *op, (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_ai not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_get_flt(pTHX_ mpfr_t * a, SV * round) { #if MPFR_VERSION_MAJOR >= 3 return newSVnv(mpfr_get_flt(*a, (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_get_flt not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_set_flt(pTHX_ mpfr_t * rop, SV * f, SV * round) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_set_flt(*rop, (float)SvNV(f), (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_set_flt not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_urandom(pTHX_ mpfr_t * rop, gmp_randstate_t* state, SV * round) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_urandom(*rop, *state, (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_urandom not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_set_z_2exp(pTHX_ mpfr_t * rop, mpz_t * op, SV * exp, SV * round) { #if MPFR_VERSION_MAJOR >= 3 return newSViv(mpfr_set_z_2exp(*rop, *op, (mpfr_exp_t)SvIV(exp), (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_set_z_2exp not implemented with this version of the mpfr library - we have %s but need at least 3.0.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_buildopt_tune_case(pTHX) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 return newSVpv(mpfr_buildopt_tune_case(), 0); #else croak("Rmpfr_buildopt_tune_case not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_frexp(pTHX_ SV * exp, mpfr_t * rop, mpfr_t * op, SV * round) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 mpfr_exp_t _exp; int ret; ret = mpfr_frexp(&_exp, *rop, *op, (mp_rnd_t)SvUV(round)); sv_setiv(exp, _exp); return newSViv(ret); #else croak("Rmpfr_frexp not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_z_sub(pTHX_ mpfr_t * rop, mpz_t * op1, mpfr_t * op2, SV * round) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 return newSViv(mpfr_z_sub(*rop, *op1, *op2, (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_z_sub not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_grandom(pTHX_ mpfr_t * rop1, mpfr_t * rop2, gmp_randstate_t * state, SV * round) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 return newSViv(mpfr_grandom(*rop1, *rop2, *state, (mp_rnd_t)SvUV(round))); #else croak("Rmpfr_grandom not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } void Rmpfr_clear_divby0(pTHX) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 mpfr_clear_divby0(); #else croak("Rmpfr_clear_divby0 not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } void Rmpfr_set_divby0(pTHX) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 mpfr_set_divby0(); #else croak("Rmpfr_set_divby0 not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_divby0_p(pTHX) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 return newSViv(mpfr_divby0_p()); #else croak("Rmpfr_divby0_p not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } SV * Rmpfr_buildopt_gmpinternals_p(pTHX) { #if (MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3 return newSViv(mpfr_buildopt_gmpinternals_p()); #else croak("Rmpfr_buildopt_gmpinternals_p not implemented with this version of the mpfr library - we have %s but need at least 3.1.0", MPFR_VERSION_STRING); #endif } SV * _get_xs_version(pTHX) { return newSVpv(XS_VERSION, 0); } SV * overload_inc(pTHX_ SV * p, SV * second, SV * third) { SvREFCNT_inc(p); mpfr_add_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), 1, __gmpfr_default_rounding_mode); return p; } SV * overload_dec(pTHX_ SV * p, SV * second, SV * third) { SvREFCNT_inc(p); mpfr_sub_ui(*(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), *(INT2PTR(mpfr_t *, SvIV(SvRV(p)))), 1, __gmpfr_default_rounding_mode); return p; } SV * _wrap_count(pTHX) { return newSVuv(PL_sv_count); } SV * Rmpfr_set_LD(pTHX_ mpfr_t * rop, SV * op, SV *rnd) { if(sv_isobject(op)) { const char* h = HvNAME(SvSTASH(SvRV(op))); if(strEQ(h, "Math::LongDouble")) { return newSViv(mpfr_set_ld(*rop, *(INT2PTR(long double *, SvIV(SvRV(op)))), (mp_rnd_t)SvUV(rnd))); } croak("2nd arg (a %s object) supplied to Rmpfr_set_LD needs to be a Math::LongDouble object", HvNAME(SvSTASH(SvRV(op)))); } else croak("2nd arg (which needs to be a Math::LongDouble object) supplied to Rmpfr_set_LD is not an object"); } /* int mpfr_set_decimal64 (mpfr_t rop, _Decimal64 op, mpfr_rnd_t rnd) */ SV * Rmpfr_set_DECIMAL64(pTHX_ mpfr_t * rop, SV * op, SV * rnd) { #if (!defined(MPFR_VERSION) || (MPFR_VERSION= 3 XPUSHs(sv_2mortal(newSVuv(sizeof(mpfr_exp_t)))); XPUSHs(sv_2mortal(newSVuv(sizeof(mpfr_prec_t)))); XPUSHs(sv_2mortal(newSVuv(sizeof(mpfr_rnd_t)))); #else XPUSHs(sv_2mortal(newSVuv(sizeof(mp_exp_t)))); XPUSHs(sv_2mortal(newSVuv(sizeof(mp_prec_t)))); XPUSHs(sv_2mortal(newSVuv(sizeof(mp_rnd_t)))); #endif XSRETURN(3); } SV * _ivsize(pTHX) { return newSVuv(sizeof(IV)); } SV * _nvsize(pTHX) { return newSVuv(sizeof(NV)); } SV * _FLT128_DIG(pTHX) { #ifdef FLT128_DIG return newSViv(FLT128_DIG); #else return &PL_sv_undef; #endif } SV * _LDBL_DIG(pTHX) { #ifdef LDBL_DIG return newSViv(LDBL_DIG); #else return &PL_sv_undef; #endif } SV * _DBL_DIG(pTHX) { #ifdef DBL_DIG return newSViv(DBL_DIG); #else return &PL_sv_undef; #endif } SV * _FLT128_MANT_DIG(pTHX) { #ifdef FLT128_MANT_DIG return newSViv(FLT128_MANT_DIG); #else return &PL_sv_undef; #endif } SV * _LDBL_MANT_DIG(pTHX) { #ifdef LDBL_MANT_DIG return newSViv(LDBL_MANT_DIG); #else return &PL_sv_undef; #endif } SV * _DBL_MANT_DIG(pTHX) { #ifdef DBL_MANT_DIG return newSViv(DBL_MANT_DIG); #else return &PL_sv_undef; #endif } /*/////////////////////////////////////////// ////////////////////////////////////////////*/ /* All randinit functions now moved to Math::MPFR::Random */ /* */ /*********************************************** ************************************************/ SV * Rmpfr_get_float128(pTHX_ mpfr_t * op, SV * rnd) { #ifdef CAN_PASS_FLOAT128 return newSVnv(mpfr_get_float128(*op, (mp_rnd_t)SvUV(rnd))); #else croak("Cannot use Rmpfr_get_float128 to return an NV"); #endif } void Rmpfr_get_FLOAT128(pTHX_ SV * rop, mpfr_t * op, SV * rnd) { #if (!defined(MPFR_VERSION) || (MPFR_VERSION < MPFR_VERSION_NUM(3,2,0))) croak("Perl interface to Rmpfr_get_FLOAT128 not available for this version (%s) of the mpfr library. We need at least version 3.2.0", MPFR_VERSION_STRING); #endif /* MPFR_WANT_FLOAT128 needs to have been defined prior to inclusion of mpfr.h - this is done by defining it at the 'Makefile.PL' step - see the Makefile.PL */ #ifdef MPFR_WANT_FLOAT128 if(sv_isobject(rop)) { const char* h = HvNAME(SvSTASH(SvRV(rop))); if(strEQ(h, "Math::Float128")) *(INT2PTR(float128 *, SvIV(SvRV(rop)))) = mpfr_get_float128(*op, (mp_rnd_t)SvUV(rnd)); else croak("1st arg (a %s object) supplied to Rmpfr_get_FLOAT128 needs to be a Math::Float128 object", HvNAME(SvSTASH(SvRV(rop)))); } else croak("1st arg (which needs to be a Math::Float128 object) supplied to Rmpfr_get_FLOAT128 is not an object"); #else croak("MPFR_WANT_FLOAT128 needs to have been defined when building Math::MPFR - see the Makefile.PL"); #endif } SV * Rmpfr_set_FLOAT128(pTHX_ mpfr_t * rop, SV * op, SV * rnd) { #if (!defined(MPFR_VERSION) || (MPFR_VERSION < MPFR_VERSION_NUM(3,2,0))) croak("Perl interface to Rmpfr_set_FLOAT128 not available for this version (%s) of the mpfr library. We need at least version 3.2.0", MPFR_VERSION_STRING); #endif /* MPFR_WANT_FLOAT128 needs to have been defined prior to inclusion of mpfr.h - this is done by defining it at the 'Makefile.PL' step - see the Makefile.PL */ #ifdef MPFR_WANT_FLOAT128 if(sv_isobject(op)) { const char* h = HvNAME(SvSTASH(SvRV(op))); if(strEQ(h, "Math::Float128")) return newSViv(mpfr_set_float128(*rop, *(INT2PTR(float128 *, SvIV(SvRV(op)))), (mp_rnd_t)SvUV(rnd))); croak("2nd arg (a %s object) supplied to Rmpfr_set_FLOAT128 needs to be a Math::Float128 object", HvNAME(SvSTASH(SvRV(op)))); } else croak("2nd arg (which needs to be a Math::Float128 object) supplied to Rmpfr_set_FLOAT128 is not an object"); #else croak("MPFR_WANT_FLOAT128 needs to have been defined when building Math::MPFR - see the Makefile.PL"); #endif } SV * Rmpfr_set_float128(pTHX_ mpfr_t * rop, SV * q, SV * rnd) { #ifdef CAN_PASS_FLOAT128 return newSViv(mpfr_set_float128(*rop, (float128)SvNV(q), (mp_rnd_t)SvUV(rnd))); #else croak("Cannot use Rmpfr_set_float128 to set an NV"); #endif } SV * _is_readonly(pTHX_ SV * sv) { if SvREADONLY(sv) return newSVuv(1); return newSVuv(0); } void _readonly_on(pTHX_ SV * sv) { SvREADONLY_on(sv); } void _readonly_off(pTHX_ SV * sv) { SvREADONLY_off(sv); } int _can_pass_float128(void) { #ifdef CAN_PASS_FLOAT128 return 1; #else return 0; #endif } int _mpfr_want_float128(void) { #ifdef MPFR_WANT_FLOAT128 return 1; #else return 0; #endif } int nnumflag(void) { return nnum; } void clear_nnum(void) { nnum = 0; } void set_nnum(int x) { nnum = x; } void _d_bytes(pTHX_ SV * str, unsigned int bits) { /* Assumes 64-bit double (53-bit precision mantissa) */ dXSARGS; mpfr_t temp; double ld; int i, n = 8; char * buff; void * p = &ld; if(bits != 53) croak("2nd arg to Math::MPFR::_d_bytes must be 53"); if(SvUV(_itsa(aTHX_ str)) != 4) croak("1st arg supplied to Math::MPFR::_d_bytes is not a string"); if((size_t)bits != DBL_MANT_DIG) croak("2nd arg (%u) supplied to Math::MPFR::_d_bytes does not match DBL_MANT_DIG (%u)", bits, DBL_MANT_DIG); mpfr_init2(temp, 53); mpfr_set_str(temp, SvPV_nolen(str), 0, GMP_RNDN); ld = mpfr_get_d(temp, GMP_RNDN); mpfr_clear(temp); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_d_bytes function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)p)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(n); } void _d_bytes_fr(pTHX_ mpfr_t * str, unsigned int bits) { /* Assumes 64-bit double (53-bit precision mantissa) */ dXSARGS; double ld; int i, n = 8; char * buff; void * p = &ld; if(bits != 53) croak("2nd arg to Math::MPFR::_d_bytes_fr must be 53"); if(mpfr_get_prec(*str) != 53) croak("Precison of 1st arg supplied to _d_bytes_fr must be 53, not %u", mpfr_get_prec(*str)); if((size_t)bits != DBL_MANT_DIG) croak("2nd arg (%u) supplied to Math::MPFR::_d_bytes_fr does not match DBL_MANT_DIG (%u)", bits, DBL_MANT_DIG); ld = mpfr_get_d(*str, GMP_RNDN); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_d_bytes_fr function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)p)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(n); } void _dd_bytes(pTHX_ SV * str, unsigned int bits) { /* Assumes 128-bit long double (106-bit precision mantissa) */ dXSARGS; mpfr_t temp; double msd, lsd; int i, n = 8; char * buff; void * pm = &msd; void * pl = &lsd; if(bits != 106) croak("2nd arg to Math::MPFR::_dd_bytes must be 106"); if(SvUV(_itsa(aTHX_ str)) != 4) croak("1st arg supplied to Math::MPFR::_dd_bytes is not a string"); mpfr_init2(temp, 2098); mpfr_set_str(temp, SvPV_nolen(str), 0, GMP_RNDN); msd = mpfr_get_d(temp, GMP_RNDN); mpfr_sub_d(temp, temp, msd, GMP_RNDN); lsd = mpfr_get_d(temp, GMP_RNDN); mpfr_clear(temp); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_dd_bytes function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)pm)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)pl)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(16); } void _dd_bytes_fr(pTHX_ mpfr_t * str, unsigned int bits) { /* Assumes 128-bit long double (106-bit precision mantissa) */ dXSARGS; mpfr_t temp; double msd, lsd; int i, n = 8; char * buff; void * pm = &msd; void * pl = &lsd; if(bits != 106) croak("2nd arg to Math::MPFR::_dd_bytes must be 106"); if(mpfr_get_prec(*str) != 2098) croak("Precison of 1st arg supplied to _dd_bytes_fr must be 2098, not %u", mpfr_get_prec(*str)); mpfr_init2(temp, 2098); mpfr_set(temp, *str, GMP_RNDN); /* Avoid altering the value held by *str */ msd = mpfr_get_d(temp, GMP_RNDN); mpfr_sub_d(temp, temp, msd, GMP_RNDN); lsd = mpfr_get_d(temp, GMP_RNDN); mpfr_clear(temp); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_dd_bytes_fr function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)pm)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)pl)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(16); } void _ld_bytes(pTHX_ SV * str, unsigned int bits) { /* For Math::NV - added in version 3.26 */ /* Assumes 80-bit long double (64-bit precision mantissa) */ dXSARGS; mpfr_t temp; long double ld; int i, n = 10; char * buff; void * p = &ld; if(bits != 64) { if(bits == 106) warn("\nYou probably want to call Math::MPFR::_dd_bytes\n"); croak("2nd arg to Math::MPFR::_ld_bytes must be 64"); } if(SvUV(_itsa(aTHX_ str)) != 4) croak("1st arg supplied to Math::MPFR::_ld_bytes is not a string"); if((size_t)bits != LDBL_MANT_DIG) croak("2nd arg (%u) supplied to Math::MPFR::_ld_bytes does not match LDBL_MANT_DIG (%u)", bits, LDBL_MANT_DIG); mpfr_init2(temp, 64); mpfr_set_str(temp, SvPV_nolen(str), 0, GMP_RNDN); ld = mpfr_get_ld(temp, GMP_RNDN); mpfr_clear(temp); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_ld_bytes function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)p)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(n); } void _ld_bytes_fr(pTHX_ mpfr_t * str, unsigned int bits) { /* For Math::NV - added in version 3.26 */ /* Assumes 80-bit long double (64-bit precision mantissa) */ dXSARGS; long double ld; int i, n = 10; char * buff; void * p = &ld; if(bits != 64) { if(bits == 106) warn("\nYou probably want to call Math::MPFR::_dd_bytes_fr\n"); croak("2nd arg to Math::MPFR::_ld_bytes_fr must be 64"); } if(mpfr_get_prec(*str) != 64) croak("Precison of 1st arg supplied to _ld_bytes_fr must be 64, not %u", mpfr_get_prec(*str)); if((size_t)bits != LDBL_MANT_DIG) croak("2nd arg (%u) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG (%u)", bits, LDBL_MANT_DIG); ld = mpfr_get_ld(*str, GMP_RNDN); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_ld_bytes_fr function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)p)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(n); } void _f128_bytes(pTHX_ SV * str, unsigned int bits) { /* For Math::NV - added in version 3.26 */ /* Assumes 128-bit __float128 (113-bit precision mantissa) */ #ifndef MPFR_WANT_FLOAT128 croak("__float128 support not built into this Math::MPFR"); #else dXSARGS; mpfr_t temp; float128 ld; int i, n = 16; char * buff; void * p = &ld; if(bits != 113) croak("2nd arg to Math::MPFR::_f128_bytes must be 113"); if(SvUV(_itsa(aTHX_ str)) != 4) croak("1st arg supplied to Math::MPFR::_f128_bytes is not a string"); if((size_t)bits != FLT128_MANT_DIG) croak("2nd arg (%u) supplied to Math::MPFR::_f128_bytes does not match FLT128_MANT_DIG (%u)", bits, FLT128_MANT_DIG); mpfr_init2(temp, 113); mpfr_set_str(temp, SvPV_nolen(str), 0, GMP_RNDN); ld = mpfr_get_float128(temp, GMP_RNDN); mpfr_clear(temp); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_f128_bytes function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)p)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(n); #endif } void _f128_bytes_fr(pTHX_ mpfr_t * str, unsigned int bits) { /* Assumes 128-bit __float128 (113-bit precision mantissa) */ #ifndef MPFR_WANT_FLOAT128 croak("__float128 support not built into this Math::MPFR"); #else dXSARGS; float128 ld; int i, n = 16; char * buff; void * p = &ld; if(bits != 113) croak("2nd arg to Math::MPFR::_f128_bytes_fr must be 113"); if(mpfr_get_prec(*str) != 113) croak("Precison of 1st arg supplied to _f128_bytes_fr must be 113, not %u", mpfr_get_prec(*str)); if((size_t)bits != FLT128_MANT_DIG) croak("2nd arg (%u) supplied to Math::MPFR::_f128_bytes_fr does not match FLT128_MANT_DIG (%u)", bits, FLT128_MANT_DIG); ld = mpfr_get_float128(*str, GMP_RNDN); Newx(buff, 4, char); if(buff == NULL) croak("Failed to allocate memory in Math::MPFR::_f128_bytes_fr function"); sp = mark; #ifdef MPFR_HAVE_BENDIAN /* Big Endian architecture */ for (i = 0; i < n; i++) { #else for (i = n - 1; i >= 0; i--) { #endif sprintf(buff, "%02x", ((unsigned char*)p)[i]); XPUSHs(sv_2mortal(newSVpv(buff, 0))); } PUTBACK; Safefree(buff); XSRETURN(n); #endif } int _required_ldbl_mant_dig(void) { return REQUIRED_LDBL_MANT_DIG; } SV * _GMP_LIMB_BITS(pTHX) { #ifdef GMP_LIMB_BITS return newSVuv(GMP_LIMB_BITS); #else return &PL_sv_undef; #endif } SV * _GMP_NAIL_BITS(pTHX) { #ifdef GMP_NAIL_BITS return newSVuv(GMP_NAIL_BITS); #else return &PL_sv_undef; #endif } MODULE = Math::MPFR PACKAGE = Math::MPFR PROTOTYPES: DISABLE int _has_inttypes () int NNW_val () CODE: RETVAL = NNW_val (aTHX); OUTPUT: RETVAL void Rmpfr_set_default_rounding_mode (round) SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_default_rounding_mode(aTHX_ round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ unsigned long Rmpfr_get_default_rounding_mode () SV * Rmpfr_prec_round (p, prec, round) mpfr_t * p SV * prec SV * round CODE: RETVAL = Rmpfr_prec_round (aTHX_ p, prec, round); OUTPUT: RETVAL void DESTROY (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; DESTROY(aTHX_ p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear(aTHX_ p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear_mpfr (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_mpfr(p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear_ptr (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_ptr(aTHX_ p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clears (p, ...) SV * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clears(aTHX_ p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_init () CODE: RETVAL = Rmpfr_init (aTHX); OUTPUT: RETVAL SV * Rmpfr_init2 (prec) SV * prec CODE: RETVAL = Rmpfr_init2 (aTHX_ prec); OUTPUT: RETVAL SV * Rmpfr_init_nobless () CODE: RETVAL = Rmpfr_init_nobless (aTHX); OUTPUT: RETVAL SV * Rmpfr_init2_nobless (prec) SV * prec CODE: RETVAL = Rmpfr_init2_nobless (aTHX_ prec); OUTPUT: RETVAL void Rmpfr_init_set (q, round) mpfr_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_ui (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_ui(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_si (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_si(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_d (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_d(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_ld (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_ld(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_f (q, round) mpf_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_f(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_z (q, round) mpz_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_z(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_q (q, round) mpq_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_q(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_str (q, base, round) SV * q SV * base SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_str(aTHX_ q, base, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_nobless (q, round) mpfr_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_ui_nobless (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_ui_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_si_nobless (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_si_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_d_nobless (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_d_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_ld_nobless (q, round) SV * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_ld_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_f_nobless (q, round) mpf_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_f_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_z_nobless (q, round) mpz_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_z_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_q_nobless (q, round) mpq_t * q SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_q_nobless(aTHX_ q, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_init_set_str_nobless (q, base, round) SV * q SV * base SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_init_set_str_nobless(aTHX_ q, base, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_deref2 (p, base, n_digits, round) mpfr_t * p SV * base SV * n_digits SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_deref2(aTHX_ p, base, n_digits, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_default_prec (prec) SV * prec PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_default_prec(aTHX_ prec); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_get_default_prec () CODE: RETVAL = Rmpfr_get_default_prec (aTHX); OUTPUT: RETVAL SV * Rmpfr_min_prec (x) mpfr_t * x CODE: RETVAL = Rmpfr_min_prec (aTHX_ x); OUTPUT: RETVAL void Rmpfr_set_prec (p, prec) mpfr_t * p SV * prec PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_prec(aTHX_ p, prec); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_prec_raw (p, prec) mpfr_t * p SV * prec PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_prec_raw(aTHX_ p, prec); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_get_prec (p) mpfr_t * p CODE: RETVAL = Rmpfr_get_prec (aTHX_ p); OUTPUT: RETVAL SV * Rmpfr_set (p, q, round) mpfr_t * p mpfr_t * q SV * round CODE: RETVAL = Rmpfr_set (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_ui (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_ui (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_si (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_si (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_uj (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_uj (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_sj (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_sj (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_NV (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_NV (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_ld (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_ld (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_d (p, q, round) mpfr_t * p SV * q SV * round CODE: RETVAL = Rmpfr_set_d (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_z (p, q, round) mpfr_t * p mpz_t * q SV * round CODE: RETVAL = Rmpfr_set_z (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_q (p, q, round) mpfr_t * p mpq_t * q SV * round CODE: RETVAL = Rmpfr_set_q (aTHX_ p, q, round); OUTPUT: RETVAL SV * Rmpfr_set_f (p, q, round) mpfr_t * p mpf_t * q SV * round CODE: RETVAL = Rmpfr_set_f (aTHX_ p, q, round); OUTPUT: RETVAL int Rmpfr_set_str (p, num, base, round) mpfr_t * p SV * num SV * base SV * round CODE: RETVAL = Rmpfr_set_str (aTHX_ p, num, base, round); OUTPUT: RETVAL void Rmpfr_set_inf (p, sign) mpfr_t * p int sign PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_inf(p, sign); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_nan (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_nan(p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_swap (p, q) mpfr_t * p mpfr_t * q PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_swap(p, q); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_get_d (p, round) mpfr_t * p SV * round CODE: RETVAL = Rmpfr_get_d (aTHX_ p, round); OUTPUT: RETVAL SV * Rmpfr_get_d_2exp (exp, p, round) SV * exp mpfr_t * p SV * round CODE: RETVAL = Rmpfr_get_d_2exp (aTHX_ exp, p, round); OUTPUT: RETVAL SV * Rmpfr_get_ld_2exp (exp, p, round) SV * exp mpfr_t * p SV * round CODE: RETVAL = Rmpfr_get_ld_2exp (aTHX_ exp, p, round); OUTPUT: RETVAL SV * Rmpfr_get_ld (p, round) mpfr_t * p SV * round CODE: RETVAL = Rmpfr_get_ld (aTHX_ p, round); OUTPUT: RETVAL double Rmpfr_get_d1 (p) mpfr_t * p SV * Rmpfr_get_z_2exp (z, p) mpz_t * z mpfr_t * p CODE: RETVAL = Rmpfr_get_z_2exp (aTHX_ z, p); OUTPUT: RETVAL SV * Rmpfr_add (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_add (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_add_ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_add_ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_add_d (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_add_d (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_add_si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_add_si (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_add_z (a, b, c, round) mpfr_t * a mpfr_t * b mpz_t * c SV * round CODE: RETVAL = Rmpfr_add_z (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_add_q (a, b, c, round) mpfr_t * a mpfr_t * b mpq_t * c SV * round CODE: RETVAL = Rmpfr_add_q (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sub (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_sub (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sub_ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_sub_ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sub_d (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_sub_d (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sub_z (a, b, c, round) mpfr_t * a mpfr_t * b mpz_t * c SV * round CODE: RETVAL = Rmpfr_sub_z (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sub_q (a, b, c, round) mpfr_t * a mpfr_t * b mpq_t * c SV * round CODE: RETVAL = Rmpfr_sub_q (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_ui_sub (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_ui_sub (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_d_sub (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_d_sub (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_mul (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_mul_ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_d (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_mul_d (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_z (a, b, c, round) mpfr_t * a mpfr_t * b mpz_t * c SV * round CODE: RETVAL = Rmpfr_mul_z (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_q (a, b, c, round) mpfr_t * a mpfr_t * b mpq_t * c SV * round CODE: RETVAL = Rmpfr_mul_q (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_dim (rop, op1, op2, round) mpfr_t * rop mpfr_t * op1 mpfr_t * op2 SV * round CODE: RETVAL = Rmpfr_dim (aTHX_ rop, op1, op2, round); OUTPUT: RETVAL SV * Rmpfr_div (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_div (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_div_ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_d (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_div_d (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_z (a, b, c, round) mpfr_t * a mpfr_t * b mpz_t * c SV * round CODE: RETVAL = Rmpfr_div_z (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_q (a, b, c, round) mpfr_t * a mpfr_t * b mpq_t * c SV * round CODE: RETVAL = Rmpfr_div_q (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_ui_div (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_ui_div (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_d_div (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_d_div (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sqrt (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_sqrt (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_rec_sqrt (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_rec_sqrt (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_cbrt (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_cbrt (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_sqrt_ui (a, b, round) mpfr_t * a SV * b SV * round CODE: RETVAL = Rmpfr_sqrt_ui (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_pow_ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_pow_ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_ui_pow_ui (a, b, c, round) mpfr_t * a SV * b SV * c SV * round CODE: RETVAL = Rmpfr_ui_pow_ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_ui_pow (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_ui_pow (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_pow_si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_pow_si (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_pow (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_pow (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_neg (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_neg (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_abs (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_abs (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_mul_2exp (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_mul_2exp (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_2ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_mul_2ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_2si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_mul_2si (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_2exp (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_div_2exp (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_2ui (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_div_2ui (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_2si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_div_2si (aTHX_ a, b, c, round); OUTPUT: RETVAL int Rmpfr_cmp (a, b) mpfr_t * a mpfr_t * b int Rmpfr_cmpabs (a, b) mpfr_t * a mpfr_t * b int Rmpfr_cmp_ui (a, b) mpfr_t * a unsigned long b int Rmpfr_cmp_d (a, b) mpfr_t * a double b int Rmpfr_cmp_ld (a, b) mpfr_t * a SV * b CODE: RETVAL = Rmpfr_cmp_ld (aTHX_ a, b); OUTPUT: RETVAL int Rmpfr_cmp_si (a, b) mpfr_t * a long b int Rmpfr_cmp_ui_2exp (a, b, c) mpfr_t * a SV * b SV * c CODE: RETVAL = Rmpfr_cmp_ui_2exp (aTHX_ a, b, c); OUTPUT: RETVAL int Rmpfr_cmp_si_2exp (a, b, c) mpfr_t * a SV * b SV * c CODE: RETVAL = Rmpfr_cmp_si_2exp (aTHX_ a, b, c); OUTPUT: RETVAL int Rmpfr_eq (a, b, c) mpfr_t * a mpfr_t * b unsigned long c int Rmpfr_nan_p (p) mpfr_t * p int Rmpfr_inf_p (p) mpfr_t * p int Rmpfr_number_p (p) mpfr_t * p void Rmpfr_reldiff (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_reldiff(aTHX_ a, b, c, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int Rmpfr_sgn (p) mpfr_t * p int Rmpfr_greater_p (a, b) mpfr_t * a mpfr_t * b int Rmpfr_greaterequal_p (a, b) mpfr_t * a mpfr_t * b int Rmpfr_less_p (a, b) mpfr_t * a mpfr_t * b int Rmpfr_lessequal_p (a, b) mpfr_t * a mpfr_t * b int Rmpfr_lessgreater_p (a, b) mpfr_t * a mpfr_t * b int Rmpfr_equal_p (a, b) mpfr_t * a mpfr_t * b int Rmpfr_unordered_p (a, b) mpfr_t * a mpfr_t * b SV * Rmpfr_sin_cos (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_sin_cos (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sinh_cosh (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_sinh_cosh (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sin (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_sin (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_cos (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_cos (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_tan (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_tan (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_asin (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_asin (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_acos (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_acos (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_atan (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_atan (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_sinh (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_sinh (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_cosh (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_cosh (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_tanh (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_tanh (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_asinh (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_asinh (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_acosh (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_acosh (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_atanh (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_atanh (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_fac_ui (a, b, round) mpfr_t * a SV * b SV * round CODE: RETVAL = Rmpfr_fac_ui (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_log1p (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_log1p (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_expm1 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_expm1 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_log2 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_log2 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_log10 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_log10 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_fma (a, b, c, d, round) mpfr_t * a mpfr_t * b mpfr_t * c mpfr_t * d SV * round CODE: RETVAL = Rmpfr_fma (aTHX_ a, b, c, d, round); OUTPUT: RETVAL SV * Rmpfr_fms (a, b, c, d, round) mpfr_t * a mpfr_t * b mpfr_t * c mpfr_t * d SV * round CODE: RETVAL = Rmpfr_fms (aTHX_ a, b, c, d, round); OUTPUT: RETVAL SV * Rmpfr_agm (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_agm (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_hypot (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_hypot (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_const_log2 (p, round) mpfr_t * p SV * round CODE: RETVAL = Rmpfr_const_log2 (aTHX_ p, round); OUTPUT: RETVAL SV * Rmpfr_const_pi (p, round) mpfr_t * p SV * round CODE: RETVAL = Rmpfr_const_pi (aTHX_ p, round); OUTPUT: RETVAL SV * Rmpfr_const_euler (p, round) mpfr_t * p SV * round CODE: RETVAL = Rmpfr_const_euler (aTHX_ p, round); OUTPUT: RETVAL SV * Rmpfr_rint (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_rint (aTHX_ a, b, round); OUTPUT: RETVAL int Rmpfr_ceil (a, b) mpfr_t * a mpfr_t * b int Rmpfr_floor (a, b) mpfr_t * a mpfr_t * b int Rmpfr_round (a, b) mpfr_t * a mpfr_t * b int Rmpfr_trunc (a, b) mpfr_t * a mpfr_t * b SV * Rmpfr_can_round (p, err, round1, round2, prec) mpfr_t * p SV * err SV * round1 SV * round2 SV * prec CODE: RETVAL = Rmpfr_can_round (aTHX_ p, err, round1, round2, prec); OUTPUT: RETVAL SV * Rmpfr_print_rnd_mode (rnd) SV * rnd CODE: RETVAL = Rmpfr_print_rnd_mode (aTHX_ rnd); OUTPUT: RETVAL SV * Rmpfr_get_emin () CODE: RETVAL = Rmpfr_get_emin (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_emax () CODE: RETVAL = Rmpfr_get_emax (aTHX); OUTPUT: RETVAL int Rmpfr_set_emin (e) SV * e CODE: RETVAL = Rmpfr_set_emin (aTHX_ e); OUTPUT: RETVAL int Rmpfr_set_emax (e) SV * e CODE: RETVAL = Rmpfr_set_emax (aTHX_ e); OUTPUT: RETVAL SV * Rmpfr_check_range (p, t, round) mpfr_t * p SV * t SV * round CODE: RETVAL = Rmpfr_check_range (aTHX_ p, t, round); OUTPUT: RETVAL void Rmpfr_clear_underflow () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_underflow(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear_overflow () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_overflow(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear_nanflag () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_nanflag(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear_inexflag () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_inexflag(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_clear_flags () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_flags(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int Rmpfr_underflow_p () int Rmpfr_overflow_p () int Rmpfr_nanflag_p () int Rmpfr_inexflag_p () SV * Rmpfr_log (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_log (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_exp (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_exp (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_exp2 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_exp2 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_exp10 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_exp10 (aTHX_ a, b, round); OUTPUT: RETVAL void Rmpfr_urandomb (x, ...) SV * x PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_urandomb(aTHX_ x); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_random2 (p, s, exp) mpfr_t * p SV * s SV * exp PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_random2(aTHX_ p, s, exp); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * _TRmpfr_out_str (stream, base, dig, p, round) FILE * stream SV * base SV * dig mpfr_t * p SV * round CODE: RETVAL = _TRmpfr_out_str (aTHX_ stream, base, dig, p, round); OUTPUT: RETVAL SV * _Rmpfr_out_str (p, base, dig, round) mpfr_t * p SV * base SV * dig SV * round CODE: RETVAL = _Rmpfr_out_str (aTHX_ p, base, dig, round); OUTPUT: RETVAL SV * _TRmpfr_out_strS (stream, base, dig, p, round, suff) FILE * stream SV * base SV * dig mpfr_t * p SV * round SV * suff CODE: RETVAL = _TRmpfr_out_strS (aTHX_ stream, base, dig, p, round, suff); OUTPUT: RETVAL SV * _TRmpfr_out_strP (pre, stream, base, dig, p, round) SV * pre FILE * stream SV * base SV * dig mpfr_t * p SV * round CODE: RETVAL = _TRmpfr_out_strP (aTHX_ pre, stream, base, dig, p, round); OUTPUT: RETVAL SV * _TRmpfr_out_strPS (pre, stream, base, dig, p, round, suff) SV * pre FILE * stream SV * base SV * dig mpfr_t * p SV * round SV * suff CODE: RETVAL = _TRmpfr_out_strPS (aTHX_ pre, stream, base, dig, p, round, suff); OUTPUT: RETVAL SV * _Rmpfr_out_strS (p, base, dig, round, suff) mpfr_t * p SV * base SV * dig SV * round SV * suff CODE: RETVAL = _Rmpfr_out_strS (aTHX_ p, base, dig, round, suff); OUTPUT: RETVAL SV * _Rmpfr_out_strP (pre, p, base, dig, round) SV * pre mpfr_t * p SV * base SV * dig SV * round CODE: RETVAL = _Rmpfr_out_strP (aTHX_ pre, p, base, dig, round); OUTPUT: RETVAL SV * _Rmpfr_out_strPS (pre, p, base, dig, round, suff) SV * pre mpfr_t * p SV * base SV * dig SV * round SV * suff CODE: RETVAL = _Rmpfr_out_strPS (aTHX_ pre, p, base, dig, round, suff); OUTPUT: RETVAL SV * TRmpfr_inp_str (p, stream, base, round) mpfr_t * p FILE * stream SV * base SV * round CODE: RETVAL = TRmpfr_inp_str (aTHX_ p, stream, base, round); OUTPUT: RETVAL SV * Rmpfr_inp_str (p, base, round) mpfr_t * p SV * base SV * round CODE: RETVAL = Rmpfr_inp_str (aTHX_ p, base, round); OUTPUT: RETVAL SV * Rmpfr_gamma (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_gamma (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_zeta (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_zeta (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_zeta_ui (a, b, round) mpfr_t * a SV * b SV * round CODE: RETVAL = Rmpfr_zeta_ui (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_erf (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_erf (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_frac (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_frac (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_remainder (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_remainder (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_modf (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_modf (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_fmod (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_fmod (aTHX_ a, b, c, round); OUTPUT: RETVAL void Rmpfr_remquo (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_remquo(aTHX_ a, b, c, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int Rmpfr_integer_p (p) mpfr_t * p void Rmpfr_nexttoward (a, b) mpfr_t * a mpfr_t * b PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_nexttoward(a, b); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_nextabove (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_nextabove(p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_nextbelow (p) mpfr_t * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_nextbelow(p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_min (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_min (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_max (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_max (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_get_exp (p) mpfr_t * p CODE: RETVAL = Rmpfr_get_exp (aTHX_ p); OUTPUT: RETVAL SV * Rmpfr_set_exp (p, exp) mpfr_t * p SV * exp CODE: RETVAL = Rmpfr_set_exp (aTHX_ p, exp); OUTPUT: RETVAL int Rmpfr_signbit (op) mpfr_t * op SV * Rmpfr_setsign (rop, op, sign, round) mpfr_t * rop mpfr_t * op SV * sign SV * round CODE: RETVAL = Rmpfr_setsign (aTHX_ rop, op, sign, round); OUTPUT: RETVAL SV * Rmpfr_copysign (rop, op1, op2, round) mpfr_t * rop mpfr_t * op1 mpfr_t * op2 SV * round CODE: RETVAL = Rmpfr_copysign (aTHX_ rop, op1, op2, round); OUTPUT: RETVAL SV * get_refcnt (s) SV * s CODE: RETVAL = get_refcnt (aTHX_ s); OUTPUT: RETVAL SV * get_package_name (x) SV * x CODE: RETVAL = get_package_name (aTHX_ x); OUTPUT: RETVAL void Rmpfr_dump (a) mpfr_t * a PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_dump(a); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * gmp_v () CODE: RETVAL = gmp_v (aTHX); OUTPUT: RETVAL SV * Rmpfr_set_ui_2exp (a, b, c, round) mpfr_t * a SV * b SV * c SV * round CODE: RETVAL = Rmpfr_set_ui_2exp (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_set_si_2exp (a, b, c, round) mpfr_t * a SV * b SV * c SV * round CODE: RETVAL = Rmpfr_set_si_2exp (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_set_uj_2exp (a, b, c, round) mpfr_t * a SV * b SV * c SV * round CODE: RETVAL = Rmpfr_set_uj_2exp (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_set_sj_2exp (a, b, c, round) mpfr_t * a SV * b SV * c SV * round CODE: RETVAL = Rmpfr_set_sj_2exp (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_get_z (a, b, round) mpz_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_get_z (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_si_sub (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_si_sub (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sub_si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_sub_si (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_mul_si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_mul_si (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_si_div (a, b, c, round) mpfr_t * a SV * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_si_div (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_div_si (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_div_si (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_sqr (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_sqr (aTHX_ a, b, round); OUTPUT: RETVAL int Rmpfr_cmp_z (a, b) mpfr_t * a mpz_t * b int Rmpfr_cmp_q (a, b) mpfr_t * a mpq_t * b int Rmpfr_cmp_f (a, b) mpfr_t * a mpf_t * b int Rmpfr_zero_p (a) mpfr_t * a void Rmpfr_free_cache () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_free_cache(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_get_version () CODE: RETVAL = Rmpfr_get_version (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_patches () CODE: RETVAL = Rmpfr_get_patches (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_emin_min () CODE: RETVAL = Rmpfr_get_emin_min (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_emin_max () CODE: RETVAL = Rmpfr_get_emin_max (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_emax_min () CODE: RETVAL = Rmpfr_get_emax_min (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_emax_max () CODE: RETVAL = Rmpfr_get_emax_max (aTHX); OUTPUT: RETVAL void Rmpfr_clear_erangeflag () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_erangeflag(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int Rmpfr_erangeflag_p () SV * Rmpfr_rint_round (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_rint_round (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_rint_trunc (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_rint_trunc (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_rint_ceil (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_rint_ceil (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_rint_floor (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_rint_floor (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_get_ui (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_get_ui (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_get_si (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_get_si (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_get_uj (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_get_uj (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_get_sj (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_get_sj (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_get_IV (x, round) mpfr_t * x SV * round CODE: RETVAL = Rmpfr_get_IV (aTHX_ x, round); OUTPUT: RETVAL SV * Rmpfr_get_UV (x, round) mpfr_t * x SV * round CODE: RETVAL = Rmpfr_get_UV (aTHX_ x, round); OUTPUT: RETVAL SV * Rmpfr_get_NV (x, round) mpfr_t * x SV * round CODE: RETVAL = Rmpfr_get_NV (aTHX_ x, round); OUTPUT: RETVAL SV * Rmpfr_fits_ulong_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_ulong_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_slong_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_slong_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_ushort_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_ushort_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_sshort_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_sshort_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_uint_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_uint_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_sint_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_sint_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_uintmax_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_uintmax_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_intmax_p (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_fits_intmax_p (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_fits_IV_p (x, round) mpfr_t * x SV * round CODE: RETVAL = Rmpfr_fits_IV_p (aTHX_ x, round); OUTPUT: RETVAL SV * Rmpfr_fits_UV_p (x, round) mpfr_t * x SV * round CODE: RETVAL = Rmpfr_fits_UV_p (aTHX_ x, round); OUTPUT: RETVAL SV * Rmpfr_strtofr (a, str, base, round) mpfr_t * a SV * str SV * base SV * round CODE: RETVAL = Rmpfr_strtofr (aTHX_ a, str, base, round); OUTPUT: RETVAL void Rmpfr_set_erangeflag () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_erangeflag(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_underflow () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_underflow(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_overflow () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_overflow(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_nanflag () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_nanflag(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_inexflag () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_inexflag(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_erfc (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_erfc (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_j0 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_j0 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_j1 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_j1 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_jn (a, n, b, round) mpfr_t * a SV * n mpfr_t * b SV * round CODE: RETVAL = Rmpfr_jn (aTHX_ a, n, b, round); OUTPUT: RETVAL SV * Rmpfr_y0 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_y0 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_y1 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_y1 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_yn (a, n, b, round) mpfr_t * a SV * n mpfr_t * b SV * round CODE: RETVAL = Rmpfr_yn (aTHX_ a, n, b, round); OUTPUT: RETVAL SV * Rmpfr_atan2 (a, b, c, round) mpfr_t * a mpfr_t * b mpfr_t * c SV * round CODE: RETVAL = Rmpfr_atan2 (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_pow_z (a, b, c, round) mpfr_t * a mpfr_t * b mpz_t * c SV * round CODE: RETVAL = Rmpfr_pow_z (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_subnormalize (a, b, round) mpfr_t * a SV * b SV * round CODE: RETVAL = Rmpfr_subnormalize (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_const_catalan (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_const_catalan (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_sec (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_sec (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_csc (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_csc (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_cot (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_cot (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_root (a, b, c, round) mpfr_t * a mpfr_t * b SV * c SV * round CODE: RETVAL = Rmpfr_root (aTHX_ a, b, c, round); OUTPUT: RETVAL SV * Rmpfr_eint (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_eint (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_li2 (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_li2 (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_get_f (a, b, round) mpf_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_get_f (aTHX_ a, b, round); OUTPUT: RETVAL void Rmpfr_get_q (a, b) mpq_t * a mpfr_t * b PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_get_q(a, b); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_sech (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_sech (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_csch (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_csch (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_coth (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_coth (aTHX_ a, b, round); OUTPUT: RETVAL SV * Rmpfr_lngamma (a, b, round) mpfr_t * a mpfr_t * b SV * round CODE: RETVAL = Rmpfr_lngamma (aTHX_ a, b, round); OUTPUT: RETVAL void Rmpfr_lgamma (a, b, round) mpfr_t * a mpfr_t * b SV * round PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_lgamma(aTHX_ a, b, round); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * _MPFR_VERSION () CODE: RETVAL = _MPFR_VERSION (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_MAJOR () CODE: RETVAL = _MPFR_VERSION_MAJOR (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_MINOR () CODE: RETVAL = _MPFR_VERSION_MINOR (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_PATCHLEVEL () CODE: RETVAL = _MPFR_VERSION_PATCHLEVEL (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_STRING () CODE: RETVAL = _MPFR_VERSION_STRING (aTHX); OUTPUT: RETVAL SV * RMPFR_VERSION_NUM (a, b, c) SV * a SV * b SV * c CODE: RETVAL = RMPFR_VERSION_NUM (aTHX_ a, b, c); OUTPUT: RETVAL SV * Rmpfr_sum (rop, avref, len, round) mpfr_t * rop SV * avref SV * len SV * round CODE: RETVAL = Rmpfr_sum (aTHX_ rop, avref, len, round); OUTPUT: RETVAL SV * overload_mul (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_mul (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_add (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_add (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_sub (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_sub (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_div (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_div (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_copy (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_copy (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_abs (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_abs (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_gt (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_gt (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_gte (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_gte (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_lt (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_lt (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_lte (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_lte (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_spaceship (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_spaceship (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_equiv (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_equiv (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_not_equiv (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_not_equiv (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_true (a, second, third) mpfr_t * a SV * second SV * third CODE: RETVAL = overload_true (aTHX_ a, second, third); OUTPUT: RETVAL SV * overload_not (a, second, third) mpfr_t * a SV * second SV * third CODE: RETVAL = overload_not (aTHX_ a, second, third); OUTPUT: RETVAL SV * overload_sqrt (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_sqrt (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_pow (p, second, third) SV * p SV * second SV * third CODE: RETVAL = overload_pow (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_log (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_log (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_exp (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_exp (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_sin (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_sin (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_cos (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_cos (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_int (p, second, third) mpfr_t * p SV * second SV * third CODE: RETVAL = overload_int (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_atan2 (a, b, third) mpfr_t * a SV * b SV * third CODE: RETVAL = overload_atan2 (aTHX_ a, b, third); OUTPUT: RETVAL SV * Rmpfr_randinit_default_nobless () CODE: RETVAL = Rmpfr_randinit_default_nobless (aTHX); OUTPUT: RETVAL SV * Rmpfr_randinit_mt_nobless () CODE: RETVAL = Rmpfr_randinit_mt_nobless (aTHX); OUTPUT: RETVAL SV * Rmpfr_randinit_lc_2exp_nobless (a, c, m2exp) SV * a SV * c SV * m2exp CODE: RETVAL = Rmpfr_randinit_lc_2exp_nobless (aTHX_ a, c, m2exp); OUTPUT: RETVAL SV * Rmpfr_randinit_lc_2exp_size_nobless (size) SV * size CODE: RETVAL = Rmpfr_randinit_lc_2exp_size_nobless (aTHX_ size); OUTPUT: RETVAL void Rmpfr_randclear (p) SV * p PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_randclear(aTHX_ p); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_randseed (state, seed) SV * state SV * seed PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_randseed(aTHX_ state, seed); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_randseed_ui (state, seed) SV * state SV * seed PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_randseed_ui(aTHX_ state, seed); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * overload_pow_eq (p, second, third) SV * p SV * second SV * third CODE: RETVAL = overload_pow_eq (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_div_eq (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_div_eq (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_sub_eq (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_sub_eq (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_add_eq (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_add_eq (aTHX_ a, b, third); OUTPUT: RETVAL SV * overload_mul_eq (a, b, third) SV * a SV * b SV * third CODE: RETVAL = overload_mul_eq (aTHX_ a, b, third); OUTPUT: RETVAL SV * _itsa (a) SV * a CODE: RETVAL = _itsa (aTHX_ a); OUTPUT: RETVAL int _has_longlong () int _has_longdouble () int _ivsize_bits () SV * RMPFR_PREC_MAX () CODE: RETVAL = RMPFR_PREC_MAX (aTHX); OUTPUT: RETVAL SV * RMPFR_PREC_MIN () CODE: RETVAL = RMPFR_PREC_MIN (aTHX); OUTPUT: RETVAL SV * wrap_mpfr_printf (a, b) SV * a SV * b CODE: RETVAL = wrap_mpfr_printf (aTHX_ a, b); OUTPUT: RETVAL SV * wrap_mpfr_fprintf (stream, a, b) FILE * stream SV * a SV * b CODE: RETVAL = wrap_mpfr_fprintf (aTHX_ stream, a, b); OUTPUT: RETVAL SV * wrap_mpfr_sprintf (s, a, b, buflen) SV * s SV * a SV * b int buflen CODE: RETVAL = wrap_mpfr_sprintf (aTHX_ s, a, b, buflen); OUTPUT: RETVAL SV * wrap_mpfr_snprintf (s, bytes, a, b, buflen) SV * s SV * bytes SV * a SV * b int buflen CODE: RETVAL = wrap_mpfr_snprintf (aTHX_ s, bytes, a, b, buflen); OUTPUT: RETVAL SV * wrap_mpfr_printf_rnd (a, round, b) SV * a SV * round SV * b CODE: RETVAL = wrap_mpfr_printf_rnd (aTHX_ a, round, b); OUTPUT: RETVAL SV * wrap_mpfr_fprintf_rnd (stream, a, round, b) FILE * stream SV * a SV * round SV * b CODE: RETVAL = wrap_mpfr_fprintf_rnd (aTHX_ stream, a, round, b); OUTPUT: RETVAL SV * wrap_mpfr_sprintf_rnd (s, a, round, b, buflen) SV * s SV * a SV * round SV * b int buflen CODE: RETVAL = wrap_mpfr_sprintf_rnd (aTHX_ s, a, round, b, buflen); OUTPUT: RETVAL SV * wrap_mpfr_snprintf_rnd (s, bytes, a, round, b, buflen) SV * s SV * bytes SV * a SV * round SV * b int buflen CODE: RETVAL = wrap_mpfr_snprintf_rnd (aTHX_ s, bytes, a, round, b, buflen); OUTPUT: RETVAL SV * Rmpfr_buildopt_tls_p () CODE: RETVAL = Rmpfr_buildopt_tls_p (aTHX); OUTPUT: RETVAL SV * Rmpfr_buildopt_decimal_p () CODE: RETVAL = Rmpfr_buildopt_decimal_p (aTHX); OUTPUT: RETVAL SV * Rmpfr_regular_p (a) mpfr_t * a CODE: RETVAL = Rmpfr_regular_p (aTHX_ a); OUTPUT: RETVAL void Rmpfr_set_zero (a, sign) mpfr_t * a SV * sign PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_zero(aTHX_ a, sign); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_digamma (rop, op, round) mpfr_t * rop mpfr_t * op SV * round CODE: RETVAL = Rmpfr_digamma (aTHX_ rop, op, round); OUTPUT: RETVAL SV * Rmpfr_ai (rop, op, round) mpfr_t * rop mpfr_t * op SV * round CODE: RETVAL = Rmpfr_ai (aTHX_ rop, op, round); OUTPUT: RETVAL SV * Rmpfr_get_flt (a, round) mpfr_t * a SV * round CODE: RETVAL = Rmpfr_get_flt (aTHX_ a, round); OUTPUT: RETVAL SV * Rmpfr_set_flt (rop, f, round) mpfr_t * rop SV * f SV * round CODE: RETVAL = Rmpfr_set_flt (aTHX_ rop, f, round); OUTPUT: RETVAL SV * Rmpfr_urandom (rop, state, round) mpfr_t * rop gmp_randstate_t * state SV * round CODE: RETVAL = Rmpfr_urandom (aTHX_ rop, state, round); OUTPUT: RETVAL SV * Rmpfr_set_z_2exp (rop, op, exp, round) mpfr_t * rop mpz_t * op SV * exp SV * round CODE: RETVAL = Rmpfr_set_z_2exp (aTHX_ rop, op, exp, round); OUTPUT: RETVAL SV * Rmpfr_buildopt_tune_case () CODE: RETVAL = Rmpfr_buildopt_tune_case (aTHX); OUTPUT: RETVAL SV * Rmpfr_frexp (exp, rop, op, round) SV * exp mpfr_t * rop mpfr_t * op SV * round CODE: RETVAL = Rmpfr_frexp (aTHX_ exp, rop, op, round); OUTPUT: RETVAL SV * Rmpfr_z_sub (rop, op1, op2, round) mpfr_t * rop mpz_t * op1 mpfr_t * op2 SV * round CODE: RETVAL = Rmpfr_z_sub (aTHX_ rop, op1, op2, round); OUTPUT: RETVAL SV * Rmpfr_grandom (rop1, rop2, state, round) mpfr_t * rop1 mpfr_t * rop2 gmp_randstate_t * state SV * round CODE: RETVAL = Rmpfr_grandom (aTHX_ rop1, rop2, state, round); OUTPUT: RETVAL void Rmpfr_clear_divby0 () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_clear_divby0(aTHX); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_set_divby0 () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_set_divby0(aTHX); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_divby0_p () CODE: RETVAL = Rmpfr_divby0_p (aTHX); OUTPUT: RETVAL SV * Rmpfr_buildopt_gmpinternals_p () CODE: RETVAL = Rmpfr_buildopt_gmpinternals_p (aTHX); OUTPUT: RETVAL SV * _get_xs_version () CODE: RETVAL = _get_xs_version (aTHX); OUTPUT: RETVAL SV * overload_inc (p, second, third) SV * p SV * second SV * third CODE: RETVAL = overload_inc (aTHX_ p, second, third); OUTPUT: RETVAL SV * overload_dec (p, second, third) SV * p SV * second SV * third CODE: RETVAL = overload_dec (aTHX_ p, second, third); OUTPUT: RETVAL SV * _wrap_count () CODE: RETVAL = _wrap_count (aTHX); OUTPUT: RETVAL SV * Rmpfr_set_LD (rop, op, rnd) mpfr_t * rop SV * op SV * rnd CODE: RETVAL = Rmpfr_set_LD (aTHX_ rop, op, rnd); OUTPUT: RETVAL SV * Rmpfr_set_DECIMAL64 (rop, op, rnd) mpfr_t * rop SV * op SV * rnd CODE: RETVAL = Rmpfr_set_DECIMAL64 (aTHX_ rop, op, rnd); OUTPUT: RETVAL void Rmpfr_get_LD (rop, op, rnd) SV * rop mpfr_t * op SV * rnd PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_get_LD(aTHX_ rop, op, rnd); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void Rmpfr_get_DECIMAL64 (rop, op, rnd) SV * rop mpfr_t * op SV * rnd PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_get_DECIMAL64(aTHX_ rop, op, rnd); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int _MPFR_WANT_DECIMAL_FLOATS () int _MPFR_WANT_FLOAT128 () SV * _max_base () CODE: RETVAL = _max_base (aTHX); OUTPUT: RETVAL SV * _isobject (x) SV * x CODE: RETVAL = _isobject (aTHX_ x); OUTPUT: RETVAL void _mp_sizes () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _mp_sizes(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * _ivsize () CODE: RETVAL = _ivsize (aTHX); OUTPUT: RETVAL SV * _nvsize () CODE: RETVAL = _nvsize (aTHX); OUTPUT: RETVAL SV * _FLT128_DIG () CODE: RETVAL = _FLT128_DIG (aTHX); OUTPUT: RETVAL SV * _LDBL_DIG () CODE: RETVAL = _LDBL_DIG (aTHX); OUTPUT: RETVAL SV * _DBL_DIG () CODE: RETVAL = _DBL_DIG (aTHX); OUTPUT: RETVAL SV * _FLT128_MANT_DIG () CODE: RETVAL = _FLT128_MANT_DIG (aTHX); OUTPUT: RETVAL SV * _LDBL_MANT_DIG () CODE: RETVAL = _LDBL_MANT_DIG (aTHX); OUTPUT: RETVAL SV * _DBL_MANT_DIG () CODE: RETVAL = _DBL_MANT_DIG (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_float128 (op, rnd) mpfr_t * op SV * rnd CODE: RETVAL = Rmpfr_get_float128 (aTHX_ op, rnd); OUTPUT: RETVAL void Rmpfr_get_FLOAT128 (rop, op, rnd) SV * rop mpfr_t * op SV * rnd PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; Rmpfr_get_FLOAT128(aTHX_ rop, op, rnd); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ SV * Rmpfr_set_FLOAT128 (rop, op, rnd) mpfr_t * rop SV * op SV * rnd CODE: RETVAL = Rmpfr_set_FLOAT128 (aTHX_ rop, op, rnd); OUTPUT: RETVAL SV * Rmpfr_set_float128 (rop, q, rnd) mpfr_t * rop SV * q SV * rnd CODE: RETVAL = Rmpfr_set_float128 (aTHX_ rop, q, rnd); OUTPUT: RETVAL SV * _is_readonly (sv) SV * sv CODE: RETVAL = _is_readonly (aTHX_ sv); OUTPUT: RETVAL void _readonly_on (sv) SV * sv PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _readonly_on(aTHX_ sv); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _readonly_off (sv) SV * sv PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _readonly_off(aTHX_ sv); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int _can_pass_float128 () int _mpfr_want_float128 () int nnumflag () void clear_nnum () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; clear_nnum(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void set_nnum (x) int x PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; set_nnum(x); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _d_bytes (str, bits) SV * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _d_bytes(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _d_bytes_fr (str, bits) mpfr_t * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _d_bytes_fr(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _dd_bytes (str, bits) SV * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _dd_bytes(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _dd_bytes_fr (str, bits) mpfr_t * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _dd_bytes_fr(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _ld_bytes (str, bits) SV * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _ld_bytes(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _ld_bytes_fr (str, bits) mpfr_t * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _ld_bytes_fr(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _f128_bytes (str, bits) SV * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _f128_bytes(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void _f128_bytes_fr (str, bits) mpfr_t * str unsigned int bits PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; _f128_bytes_fr(aTHX_ str, bits); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int _required_ldbl_mant_dig () SV * _GMP_LIMB_BITS () CODE: RETVAL = _GMP_LIMB_BITS (aTHX); OUTPUT: RETVAL SV * _GMP_NAIL_BITS () CODE: RETVAL = _GMP_NAIL_BITS (aTHX); OUTPUT: RETVAL Math-MPFR-3.32/Prec/0000755000076400010400000000000012660557757015461 5ustar sisyphusAdministratorsMath-MPFR-3.32/Prec/Makefile.PL0000644000076400010400000000041212660557734017423 0ustar sisyphusAdministratorsuse ExtUtils::MakeMaker; my %options = %{ { 'NAME' => 'Math::MPFR::Prec', 'LIBS' => $LIBS, 'INC' => $INC, 'VERSION_FROM' => 'Prec.pm' } }; WriteMakefile(%options); # Remove the Makefile dependency. Causes problems on a few systems. sub MY::makefile { '' } Math-MPFR-3.32/Prec/Prec.pm0000644000076400010400000000114412660557734016703 0ustar sisyphusAdministrators## This file generated by InlineX::C2XS (version 0.24) using Inline::C (version 0.73) # For an explanation of the existence of this module and the one (prec_cast) function # that it provides, see the FORMATTED OUTPUT section of MPFR.pm's pod. package Math::MPFR::Prec; use strict; use warnings; require Exporter; *import = \&Exporter::import; require DynaLoader; our $VERSION = '3.32'; #$VERSION = eval $VERSION; DynaLoader::bootstrap Math::MPFR::Prec $VERSION; @Math::MPFR::Prec::EXPORT = (); @Math::MPFR::Prec::EXPORT_OK = (); sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking 1; Math-MPFR-3.32/Prec/Prec.xs0000644000076400010400000000303012660557734016715 0ustar sisyphusAdministrators #ifdef __MINGW32__ #ifndef __USE_MINGW_ANSI_STDIO #define __USE_MINGW_ANSI_STDIO 1 #endif #endif #define PERL_NO_GET_CONTEXT 1 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #ifdef OLDPERL #define SvUOK SvIsUV #endif #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) #endif #ifndef mp_prec_t #define mp_prec_t mpfr_prec_t #endif SV * prec_cast(pTHX_ SV * iv) { mp_prec_t * p; SV * obj_ref, * obj; if(!SvIOK(iv)) croak("Arg supplied to Math::MPFR::Prec::prec_cast(aTHX) must be an IV/UV"); Newx(p, 1, mp_prec_t); if(p == NULL) croak("Failed to allocate memory in Math::MPFR::Prec::prec_cast(aTHX) function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR::Prec"); *p = (mp_prec_t)SvUV(iv); sv_setiv(obj, INT2PTR(IV,p)); SvREADONLY_on(obj); return obj_ref; } void DESTROY(pTHX_ SV * rop) { Safefree(INT2PTR(mp_prec_t *, SvIV(SvRV(rop)))); } MODULE = Math::MPFR::Prec PACKAGE = Math::MPFR::Prec PROTOTYPES: DISABLE SV * prec_cast (iv) SV * iv CODE: RETVAL = prec_cast (aTHX_ iv); OUTPUT: RETVAL void DESTROY (rop) SV * rop PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; DESTROY(aTHX_ rop); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ Math-MPFR-3.32/Random/0000755000076400010400000000000012660557757016010 5ustar sisyphusAdministratorsMath-MPFR-3.32/Random/Makefile.PL0000644000076400010400000000045112660557734017755 0ustar sisyphusAdministratorsuse ExtUtils::MakeMaker; my %options = %{ { 'TYPEMAPS' => [], 'NAME' => 'Math::MPFR::Random', 'LIBS' => '-lmpfr -lgmp', 'INC' => '', 'VERSION_FROM' => 'Random.pm', } }; WriteMakefile(%options); # Remove the Makefile dependency. Causes problems on a few systems. sub MY::makefile { '' } Math-MPFR-3.32/Random/Random.pm0000644000076400010400000000071512660557734017564 0ustar sisyphusAdministrators## This file generated by InlineX::C2XS (version 0.24) using Inline::C (version 0.73) package Math::MPFR::Random; use strict; use warnings; require Exporter; *import = \&Exporter::import; require DynaLoader; our $VERSION = '3.32'; #$VERSION = eval $VERSION; DynaLoader::bootstrap Math::MPFR::Random $VERSION; @Math::MPFR::Random::EXPORT = (); @Math::MPFR::Random::EXPORT_OK = (); sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking 1; Math-MPFR-3.32/Random/Random.xs0000644000076400010400000001001712660557734017576 0ustar sisyphusAdministrators #ifdef __MINGW32__ #ifndef __USE_MINGW_ANSI_STDIO #define __USE_MINGW_ANSI_STDIO 1 #endif #endif #define PERL_NO_GET_CONTEXT 1 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include /* Squash some annoying compiler warnings (Microsoft compilers only). */ #ifdef _MSC_VER #pragma warning(disable:4700 4715 4716) #endif #ifdef OLDPERL #define SvUOK SvIsUV #endif #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) #endif #ifndef Newxz # define Newxz(v,n,t) Newz(0,v,n,t) #endif /* May one day be removed from mpfr.h */ #ifndef mp_rnd_t # define mp_rnd_t mpfr_rnd_t #endif #ifndef mp_prec_t # define mp_prec_t mpfr_prec_t #endif #ifndef __gmpfr_default_rounding_mode #define __gmpfr_default_rounding_mode mpfr_get_default_rounding_mode() #endif SV * Rmpfr_randinit_default(pTHX) { gmp_randstate_t * state; SV * obj_ref, * obj; Newx(state, 1, gmp_randstate_t); if(state == NULL) croak("Failed to allocate memory in Rmpfr_randinit_default function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR::Random"); gmp_randinit_default(*state); sv_setiv(obj, INT2PTR(IV,state)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_randinit_mt(pTHX) { gmp_randstate_t * rand_obj; SV * obj_ref, * obj; Newx(rand_obj, 1, gmp_randstate_t); if(rand_obj == NULL) croak("Failed to allocate memory in Math::MPFR::Random::Rmpfr_randinit_mt function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR::Random"); gmp_randinit_mt(*rand_obj); sv_setiv(obj, INT2PTR(IV, rand_obj)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_randinit_lc_2exp(pTHX_ SV * a, SV * c, SV * m2exp ) { gmp_randstate_t * state; mpz_t aa; SV * obj_ref, * obj; Newx(state, 1, gmp_randstate_t); if(state == NULL) croak("Failed to allocate memory in Rmpfr_randinit_lc_2exp function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR::Random"); if(sv_isobject(a)) { const char* h = HvNAME(SvSTASH(SvRV(a))); if(strEQ(h, "Math::GMP") || strEQ(h, "GMP::Mpz") || strEQ(h, "Math::GMPz")) gmp_randinit_lc_2exp(*state, *(INT2PTR(mpz_t *, SvIV(SvRV(a)))), (unsigned long)SvUV(c), (unsigned long)SvUV(m2exp)); else croak("First arg to Rmpfr_randinit_lc_2exp is of invalid type"); } else { if(!mpz_init_set_str(aa, SvPV_nolen(a), 0)) { gmp_randinit_lc_2exp(*state, aa, (unsigned long)SvUV(c), (unsigned long)SvUV(m2exp)); mpz_clear(aa); } else croak("Seedstring supplied to Rmpfr_randinit_lc_2exp is not a valid number"); } sv_setiv(obj, INT2PTR(IV,state)); SvREADONLY_on(obj); return obj_ref; } SV * Rmpfr_randinit_lc_2exp_size(pTHX_ SV * size) { gmp_randstate_t * state; SV * obj_ref, * obj; if(SvUV(size) > 128) croak("The argument supplied to Rmpfr_randinit_lc_2exp_size function (%u) needs to be in the range [1..128]", SvUV(size)); Newx(state, 1, gmp_randstate_t); if(state == NULL) croak("Failed to allocate memory in Rmpfr_randinit_lc_2exp_size function"); obj_ref = newSV(0); obj = newSVrv(obj_ref, "Math::MPFR::Random"); if(gmp_randinit_lc_2exp_size(*state, (unsigned long)SvUV(size))) { sv_setiv(obj, INT2PTR(IV,state)); SvREADONLY_on(obj); return obj_ref; } croak("Rmpfr_randinit_lc_2exp_size function failed"); } void DESTROY(gmp_randstate_t * p) { gmp_randclear(*p); Safefree(p); } MODULE = Math::MPFR::Random PACKAGE = Math::MPFR::Random PROTOTYPES: DISABLE SV * Rmpfr_randinit_default () CODE: RETVAL = Rmpfr_randinit_default (aTHX); OUTPUT: RETVAL SV * Rmpfr_randinit_mt () CODE: RETVAL = Rmpfr_randinit_mt (aTHX); OUTPUT: RETVAL SV * Rmpfr_randinit_lc_2exp (a, c, m2exp) SV * a SV * c SV * m2exp CODE: RETVAL = Rmpfr_randinit_lc_2exp (aTHX_ a, c, m2exp); OUTPUT: RETVAL SV * Rmpfr_randinit_lc_2exp_size (size) SV * size CODE: RETVAL = Rmpfr_randinit_lc_2exp_size (aTHX_ size); OUTPUT: RETVAL Math-MPFR-3.32/README0000644000076400010400000001541612660557734015452 0ustar sisyphusAdministratorsThis module wraps the MPFR library functions. The MPFR library is a C library for multiple-precision floating-point computations with exact rounding (also called correct rounding). It is based on the GMP multiple-precision C library. The main goal of MPFR is to provide a library for multiple-precision floating-point computation which is both efficient and has a well-defined semantics. It copies the good ideas from the ANSI/IEEE-754 standard for double-precision floating-point arithmetic (53-bit mantissa). It also offers a wide range of trig, log, and other functions, and constants. MPFR, like GMP, is free. It is distributed under the GNU Lesser General Public License (GNU Lesser GPL). Because this module wraps the MPFR functions, it requires that both the GMP C library and the MPFR C library have been installed. For the GMP library see: http://gmplib.org For the MPFR library see: http://www.mpfr.org Minimum required version of gmp is gmp-4.2.0. Minimum required version of mpfr is mpfr-2.4.0. Some features of Math::MPFR require later versions of the gmp and mpfr libraries. You'll get errors if you try to build Math::MPFR against an insufficiently recent version of the mpfr library. To build this module you need perl 5.6.0 or later. I'm not sure of all the requirements to get it to build with earlier versions of perl, but it's definite that the XS code relating to operator overloading will not compile with perl versions prior to 5.6. Build in the usual way: perl Makefile.PL make make test make install When building this module, the GMP and MPFR libraries will need to be accessible. If those files are in a location where your compiler does not find them by default, then instead of running 'perl Makefile.PL', you'll need to run: perl Makefile.pl INC="-I/path/to/gmp_includes -I/path/to/mpfr_includes" LIBS="-L/path/to/mpfr_lib -lmpfr -L/path/to/gmp_lib -lgmp" Other commandline args you may want to provide to 'perl Makefile.PL' are D64=1 (for _Decimal64 support) and F128=1 (for __float128 support). See the Decimal64 and Float128 sections (below). ================================== 64-bit-int and long double support ================================== If your perl's Config reports that 'ivsize' is greater than or equal to 8 && 'ivtype' is not 'long', then Math::MPFR will, by default, be built with access to the mpfr_*_uj and mpfr_*_sj functions. Else, access to those functions is, by default, denied. You can override the default by opening up the Makefile.PL and uncommenting the appropriate line (just a few lines down from the top of the file ... the comments in that file should make it clear). Similarly, if your perl's Config reports that 'nvsize' is greater than 8 then Math::MPFR will, be built with access to the mpfr_*_ld functions. Else, access to those functions is, by default, denied. Again, you can override the default by opening up the Makefile.PL and uncommenting the appropriate line. I believe it to be both unnecessary and inadvisable to override the default - but if you do find that you need to override the default, please let me know. That you have found it necessary to override the default is something I probably ought to know about. I am contactable by email at sisyphus at(@) cpan dot (.) org. ========================================================= Conversion between Math::Decimal64 and Math::MPFR objects ========================================================= The functions Rmpfr_set_DECIMAL64 and Rmpfr_get_DECIMAL64 allow conversion between Math::Decimal64 (_Decimal64) and Math::MPFR (mpfr_t) objects. For this feature to be available you firstly need a compiler that has the _Decimal64 data type. Then you need to build and install Math::Decimal64. You'll also need to have the mpfr library built with _Decimal64 support. See the mpfr documentation for details of that aspect. If those pre-conditions are met, you also need to provide D64=1 as a command line argument to 'perl Makefile.PL'. (Altenatively you could edit the Makefile.PL before building Math::MPFR and set its $have_decimal64 variable to 1.) Similarly, ensuring that Decimal64 support is *not* built in can be achieved by leaving $have_decimal64 set to zero. ========================================================= Conversion between Math::Float128 and Math::MPFR objects ========================================================= The functions Rmpfr_set_FLOAT128 and Rmpfr_get_FLOAT128 allow conversion between Math::Float128 (__float128) and Math::MPFR (mpfr_t) objects. For this feature to be available you firstly need a compiler that has the __float128 data type. Then you need to build and install Math::Float128. You'll also need to have the mpfr library (version 3.2.0 at least) built with __float128 support. See the mpfr documentation for details of that aspect. (It's just a matter of providing Configure with the --enable-float128 option when building mpfr-3.2.0 or later.) If those pre-conditions are met, you also need to provide F128=1 as a command line argument to 'perl Makefile.PL'. (Altenatively you could edit the Makefile.PL before building Math::MPFR and set its $have_float128 variable to 1.) Similarly, ensuring that __float128 support is *not* built in can be achieved by leaving $have_float128 set to zero. ========================================================== Conversion between Math::LongDouble and Math::MPFR objects ========================================================== There are 2 functions provided for conversion between Math::LongDouble and Math::MPFR objects: Rmpfr_set_LD (assign the value of a Math::LongDouble object to a Math::MPFR object) Rmpfr_get_LD (assign the value of a Math::MPFR object to a Math::Long Double object) If your perl's nvtype is long double, just use Rmpfr_set_ld and Rmpfr_get_ld instead. Math::LongDouble provides 'long double' support for perls whose nvtype is other than 'long double'. ======================================================= Conversion between __float128 NV and Math::MPFR objects ======================================================= As of perl-5.21.4 it is possible to build perl with an nvtype of __float128. This is achieved by specifying -Dusequadmath as a Configure arg .... but, it will not work for all architectures and compilers. If $Config{nvtype} specifies '__float128' && if your mpfr library (need 3.2.0 or later) was built with --enable-float128 then you can pass your __float128 NV values to and from Math::MPFR using the Rmpfr_set_float128() and Rmpfr_get_float128() functions. And the overloaded operations will also accept the __float128 NV arguments as one would want. However, for that to work, you also need to have built Math::MPFR by starting with: perl Makefile.PL F128=1 (Altenatively you could edit the Makefile.PL before building Math::MPFR and set its $have_float128 variable to 1.) Math-MPFR-3.32/t/0000755000076400010400000000000012660557757015033 5ustar sisyphusAdministratorsMath-MPFR-3.32/t/base_conversion.t0000644000076400010400000000412612660557734020375 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); print "1..11\n"; eval{my $p = MPFR_DBL_DIG;}; if(!$@) { if(defined(MPFR_DBL_DIG)) { warn "\nFYI:\n DBL_DIG = ", MPFR_DBL_DIG, "\n"; } else { warn "\nFYI:\n DBL_DIG not defined\n"; } print "ok 1\n"; } else { warn "\$\@: $@"; print "not ok 1\n"; } eval{my $lp = MPFR_LDBL_DIG;}; if(!$@) { if(defined(MPFR_LDBL_DIG)) { warn "\nFYI:\n LDBL_DIG = ", MPFR_LDBL_DIG, "\n"; } else { warn "\nFYI:\n LDBL_DIG not defined\n"; } print "ok 2\n"; } else { warn "\$\@: $@"; print "not ok 2\n"; } eval{my $f128p = MPFR_FLT128_DIG;}; if(!$@) { if(defined(MPFR_FLT128_DIG)) { warn "\nFYI:\n FLT128_DIG = ", MPFR_FLT128_DIG, "\n"; } else { warn "\nFYI:\n FLT128_DIG not defined\n"; } print "ok 3\n"; } else { warn "\$\@: $@"; print "not ok 3\n"; } if(mpfr_max_orig_len(10, 2, 55) == 16){print "ok 4\n"} else { warn "\n4: Got ", mpfr_max_orig_len(10, 2, 55), "\nExpected 16\n"; print "not ok 4\n"; } if(mpfr_max_orig_len(2, 10, 17) == 53){print "ok 5\n"} else { warn "\n5: Got ", mpfr_max_orig_len(2, 10, 17), "\nExpected 53\n"; print "not ok 5\n"; } if(mpfr_min_inter_prec(2, 53, 10) == 17) {print "ok 6\n"} else { warn "\n6: Got ", mpfr_min_inter_prec(2, 53, 10), "\nExpected 17\n"; print "not ok 6\n"; } if(mpfr_min_inter_prec(10, 16, 2) == 55) {print "ok 7\n"} else { warn "\n7: Got ", mpfr_min_inter_prec(10, 16, 2), "\nExpected 55\n"; print "not ok 7\n"; } if(mpfr_max_orig_base(53, 10, 17) == 2) {print "ok 8\n"} else { warn "\n8: Got ", mpfr_max_orig_base(53, 10, 17), "\nExpected 2\n"; print "not ok 8\n"; } if(mpfr_max_orig_base(16, 2, 55) == 10) {print "ok 9\n"} else { warn "\n9: Got ", mpfr_max_orig_base(16, 2, 55), "\nExpected 10\n"; print "not ok 9\n"; } if(mpfr_min_inter_base(10, 16, 55) ==2) {print "ok 10\n"} else { warn "\n10: Got ", mpfr_min_inter_base(10, 16, 55), "\nExpected 2\n"; print "not ok 10\n"; } if(mpfr_min_inter_base(2, 53, 17) ==10) {print "ok 11\n"} else { warn "\n11: Got ", mpfr_min_inter_base(2, 53, 17), "\nExpected 10\n"; print "not ok 11\n"; } Math-MPFR-3.32/t/bessel.t0000644000076400010400000000315712660557734016476 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..1\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(100); my($val, $discard) = Rmpfr_init_set_ui(2934, GMP_RNDN); my $ret = Rmpfr_init(); my $nan = Rmpfr_init(); my $neg = Math::MPFR->new(-1); my $zero = Math::MPFR->new(0); my $inf = Math::MPFR->new(); Rmpfr_set_inf($inf, 1); my $ok = ''; Rmpfr_j0($ret, $val, GMP_RNDN); if($ret > 0.007545752435 && $ret < 0.007545752437) {$ok .= 'a'} Rmpfr_j1($ret, $val, GMP_RNDN); if($ret > -0.012649475954 && $ret < -0.012649475952) {$ok .= 'b'} Rmpfr_jn($ret, 200, $val, GMP_RNDN); if($ret > 0.012963999661 && $ret < 0.012963999663) {$ok .= 'c'} Rmpfr_y0($ret, $val, GMP_RNDN); if($ret > -0.012650761686 && $ret < -0.012650761684) {$ok .= 'd'} Rmpfr_y1($ret, $val, GMP_RNDN); if($ret > -0.007547908437 && $ret < -0.007547908435) {$ok .= 'e'} Rmpfr_yn($ret, 200, $val, GMP_RNDN); if($ret > -0.007029988802 && $ret < -0.0070299888) {$ok .= 'f'} Rmpfr_j0($ret, $nan, GMP_RNDN); if(Rmpfr_nan_p($ret)) {$ok .= 'g'} Rmpfr_j1($ret, $inf, GMP_RNDN); if(!$ret) {$ok .= 'h'} Rmpfr_j1($ret, $zero, GMP_RNDN); if(!$ret) {$ok .= 'i'} Rmpfr_y1($ret, $nan, GMP_RNDN); if(Rmpfr_nan_p($ret)) {$ok .= 'j'} Rmpfr_y0($ret, $neg, GMP_RNDN); if(Rmpfr_nan_p($ret)) {$ok .= 'k'} Rmpfr_y0($ret, $inf, GMP_RNDN); if(!$ret) {$ok .= 'l'} Rmpfr_y1($ret, $zero, GMP_RNDN); if(Rmpfr_inf_p($ret)) {$ok .= 'm'} if($ok eq 'abcdefghijklm') {print "ok 1\n"} else {print "not ok 1 $ok\n"} Math-MPFR-3.32/t/buildopt.t0000644000076400010400000000243312660557734017037 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..4\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; if(MPFR_VERSION_MAJOR >= 3) { if(defined(Rmpfr_buildopt_tls_p())) {print "ok 1\n"} else {print "not ok 1\n"} if(defined(Rmpfr_buildopt_decimal_p())) {print "ok 2\n"} else {print "not ok 2\n"} } else { eval{Rmpfr_buildopt_tls_p();}; if($@ =~ /Rmpfr_buildopt_tls_p not implemented/) {print "ok 1\n"} else {print "not ok 1\n"} eval{Rmpfr_buildopt_decimal_p();}; if($@ =~ /Rmpfr_buildopt_decimal_p not implemented/) {print "ok 2\n"} else {print "not ok 2\n"} } if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) { if(defined(Rmpfr_buildopt_tune_case())) {print "ok 3\n"} else {print "not ok 3\n"} if(defined(Rmpfr_buildopt_gmpinternals_p())) {print "ok 4\n"} else {print "not ok 4\n"} } else { eval{Rmpfr_buildopt_tune_case();}; if($@ =~ /Rmpfr_buildopt_tune_case not implemented/) {print "ok 3\n"} else {print "not ok 3\n"} eval{Rmpfr_buildopt_gmpinternals_p();}; if($@ =~ /Rmpfr_buildopt_gmpinternals_p not implemented/) {print "ok 4\n"} else {print "not ok 4\n"} } Math-MPFR-3.32/t/bytes.t0000644000076400010400000003774012660557734016354 0ustar sisyphusAdministratorsuse warnings; use strict; use Config; use Math::MPFR qw(:mpfr); print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; print "1..43\n"; my $arb = 40; Rmpfr_set_default_prec($arb); my @bytes; my $dd = 0; eval {@bytes = Math::MPFR::_ld_bytes('2.3', 64);}; if($@) { my $mess = $@; my $nv1 = 1.0; my $nv2 = $nv1 + (2 ** -1000); $dd = 1 if $nv2 != $nv1; my $bits; $bits = Math::MPFR::_required_ldbl_mant_dig() == 2098 ? 106 : Math::MPFR::_required_ldbl_mant_dig(); if((defined($Config{longdblkind}) && $Config{longdblkind} == 6) || $dd == 1) { warn "\ndouble-double detected\n"; if($mess =~ /^2nd arg \(/) {print "ok 1\n"} else { warn "\n\$\@: $mess\n"; print "not ok 1\n"; } } elsif(64 != $bits) { warn "\n$bits != 64\n"; if($mess =~ /^2nd arg \(/) {print "ok 1\n"} else { warn "\n\$\@: $mess\n"; print "not ok 1\n"; } } else { warn "\n\$\@: $mess\n"; print "not ok 1\n"; } warn "\nSkipping tests 2-4\n"; print "ok 2\nok 3\nok 4\n"; } else { my $hex = join '', @bytes; if($hex eq '40009333333333333333') {print "ok 1\n"} else { warn "expected 40009333333333333333, got $hex"; print "not ok 1\n"; } @bytes = Math::MPFR::_ld_bytes('2.93', 64); $hex = join '', @bytes; if($hex eq '4000bb851eb851eb851f') {print "ok 2\n"} else { warn "expected 4000bb851eb851eb851f, got $hex"; print "not ok 2\n"; } eval{Math::MPFR::_ld_bytes('2.93', 63);}; if($@ =~ /^2nd arg to Math::MPFR::_ld_bytes must be 64/) {print "ok 3\n"} else { warn "\nIn Math::MPFR::_ld_bytes: $@\n"; print "not ok 3\n"; } eval{Math::MPFR::_ld_bytes(2.93, 64);}; if($@ =~ /^1st arg supplied to Math::MPFR::_ld_bytes is not a string/) {print "ok 4\n"} else { warn "\nIn Math::MPFR::_ld_bytes: $@\n"; print "not ok 4\n"; } } ##################################################### ##################################################### eval {@bytes = Math::MPFR::_f128_bytes('2.3', 113);}; if($@) { my $mess = $@; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($mess =~ /^__float128 support not built into this Math::MPFR/) {print "ok 5\n"} else { warn "\n\$\@: $mess\n"; print "not ok 5\n"; } } elsif(113 != MPFR_FLT128_DIG) { my $dig = MPFR_FLT128_DIG; warn "\n$dig != 113\n"; if($mess =~ /^2nd arg \(/) {print "ok 5\n"} else { warn "\n\$\@: $mess\n"; print "not ok 5\n"; } } else { warn "\n\$\@: $mess\n"; print "not ok 5\n"; } warn "\nSkipping tests 6-8\n"; print "ok 6\nok 7\nok 8\n"; } else { my $hex = join '', @bytes; if($hex eq '40002666666666666666666666666666') {print "ok 5\n"} else { warn "expected 40002666666666666666666666666666, got $hex"; print "not ok 5\n"; } @bytes = Math::MPFR::_f128_bytes('2.93', 113); $hex = join '', @bytes; if($hex eq '4000770a3d70a3d70a3d70a3d70a3d71') {print "ok 6\n"} else { warn "expected 4000770a3d70a3d70a3d70a3d70a3d71, got $hex"; print "not ok 6\n"; } eval{Math::MPFR::_f128_bytes('2.93', 63);}; if($@ =~ /^2nd arg to Math::MPFR::_f128_bytes must be 113/) {print "ok 7\n"} else { warn "\nIn Math::MPFR::_f128_bytes: $@\n"; print "not ok 7\n"; } eval{Math::MPFR::_f128_bytes(2.93, 113);}; if($@ =~ /^1st arg supplied to Math::MPFR::_f128_bytes is not a string/) {print "ok 8\n"} else { warn "\nIn Math::MPFR::_f128_bytes: $@\n"; print "not ok 8\n"; } } my $now = Rmpfr_get_default_prec(); if($now == $arb) {print "ok 9\n"} else { warn "Default precision has changed from $arb to $now\n"; print "not ok 9\n"; } @bytes = Math::MPFR::_d_bytes('1e+129', 53); my $hex = join '', @bytes; my $double = Math::MPFR::Rmpfr_init2(53); Math::MPFR::Rmpfr_set_str($double, '1e+129', 10, 0); unless($] < 5.01) { # perl-5.8 and earlier don't understand 'pack "d<"'. my $hex2 = scalar reverse unpack "h*", pack "d<", Math::MPFR::Rmpfr_get_d($double, 0); if($hex eq $hex2) {print "ok 10\n"} else { warn "expected $hex, got $hex2\n"; print "not ok 10\n"; } } else { warn "\nSkipping test 10 for perl-5.9 and earlier\n"; print "ok 10\n"; } my @bytes2; eval{@bytes = Math::MPFR::_d_bytes('23.75', 53);}; if(!$@) { @bytes2 = Math::MPFR::_d_bytes('0x17.c', 53); my $one = join '', @bytes; my $two = join '', @bytes2; if($one eq $two) {print "ok 11\n"} else { warn "\nexpected *$one*\n got *$two*\n"; print "not ok 11\n"; } } else { warn "Skipping test 11 - $@\n"; print "ok 11\n"; } eval{@bytes = Math::MPFR::_ld_bytes('23.75', 64);}; if(!$@) { @bytes2 = Math::MPFR::_ld_bytes('0X17.C', 64); my $one = join '', @bytes; my $two = join '', @bytes2; if($one eq $two) {print "ok 12\n"} else { warn "\nexpected *$one*\n got *$two*\n"; print "not ok 12\n"; } } else { warn "Skipping test 12 - $@\n"; print "ok 12\n"; } eval{@bytes = Math::MPFR::_f128_bytes('23.75', 113);}; if(!$@) { @bytes2 = Math::MPFR::_f128_bytes('0X17.c', 113); my $one = join '', @bytes; my $two = join '', @bytes2; if($one eq $two) {print "ok 13\n"} else { warn "\nexpected *$one*\n got *$two*\n"; print "not ok 13\n"; } } else { warn "Skipping test 13 - $@\n"; print "ok 13\n"; } my $fr_breaker = Rmpfr_init2(200); Rmpfr_set_str($fr_breaker, '1.1', 10, MPFR_RNDN); eval {Math::MPFR::_d_bytes_fr($fr_breaker, 53);}; if($@ =~ /^Precison of 1st arg supplied to _d_bytes_fr must be 53, not 200/) {print "ok 14\n"} else { warn "\$\@: $@\n"; print "not ok 14\n"; } eval {Math::MPFR::_dd_bytes_fr($fr_breaker, 106);}; if($@ =~ /^Precison of 1st arg supplied to _dd_bytes_fr must be 2098, not 200/) {print "ok 15\n"} else { warn "\$\@: $@\n"; print "not ok 15\n"; } eval {Math::MPFR::_ld_bytes_fr($fr_breaker, 64);}; if($@ =~ /^Precison of 1st arg supplied to _ld_bytes_fr must be 64, not 200/) {print "ok 16\n"} else { warn "\$\@: $@\n"; print "not ok 16\n"; } eval {Math::MPFR::_f128_bytes_fr($fr_breaker, 113);}; if($@ =~ /^Precison of 1st arg supplied to _f128_bytes_fr must be 113, not 200/ || $@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 17\n"} else { warn "\$\@: $@\n"; print "not ok 17\n"; } my $d_fr = Rmpfr_init2(53); Rmpfr_set_str($d_fr, '1e+127', 10, MPFR_RNDN); my $expected = join '', Math::MPFR::_d_bytes_fr($d_fr, 53); if($expected eq '5a4d8ba7f519c84f') {print "ok 18\n"} else { warn "Expected *5a4d8ba7f519c84f*, got *$expected*\n"; print "not ok 18\n"; } my $dd_fr = Rmpfr_init2(2098); Rmpfr_set_str($dd_fr, '1e+127', 10, MPFR_RNDN); $expected = join '', Math::MPFR::_dd_bytes_fr($dd_fr, 106); if($expected eq '5a4d8ba7f519c84f56e7fd1f28f89c56') {print "ok 19\n"} else { warn "Expected *5a4d8ba7f519c84f56e7fd1f28f89c56*, got *$expected*\n"; print "not ok 19\n"; } my $ld_fr = Rmpfr_init2(64); Rmpfr_set_str($ld_fr, '1e+127', 10, MPFR_RNDN); eval {$expected = join '', Math::MPFR::_ld_bytes_fr($ld_fr, 64);}; if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) { warn "LDBL_MANT_DIG: ", Math::MPFR::_required_ldbl_mant_dig() == 2098 ? 106 : Math::MPFR::_required_ldbl_mant_dig(), "\n"; print "ok 20\n"; } elsif($@) { warn "\$\@:$@\n"; print "not ok 20\n"; } elsif($expected eq '41a4ec5d3fa8ce427b00') {print "ok 20\n"} else { warn "Expected *41a4ec5d3fa8ce427b00*, got *$expected*\n"; print "not ok 20\n"; } my $f128_fr = Rmpfr_init2(113); Rmpfr_set_str($f128_fr, '1e+127', 10, MPFR_RNDN); eval {$expected = join '', Math::MPFR::_f128_bytes_fr($f128_fr, 113);}; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 21\n"} else { warn "\n\$\@\: $@\n"; print "not ok 21\n"; } } elsif($@) { warn "\$\@:$@\n"; print "not ok 21\n"; } elsif($expected eq '41a4d8ba7f519c84f5ff47ca3e27156a') {print "ok 21\n"} else { warn "Expected *41a4d8ba7f519c84f5ff47ca3e27156a*, got *$expected*\n"; print "not ok 21\n"; } my $h; eval{$h = Math::MPFR::bytes($d_fr, 'Long Double');}; if($@ =~ /^Precison of 1st arg supplied to _ld_bytes_fr must be 64, not 53/) {print "ok 22\n"} else { warn "\$\@: $@"; print "not ok 22\n"; } eval{$h = Math::MPFR::bytes($d_fr, 53);}; if($@ =~ /^2nd arg to Math::MPFR::bytes must be/) {print "ok 23\n"} else { warn "\$\@: $@"; print "not ok 23\n"; } $expected = Math::MPFR::bytes($d_fr, 'Double'); if($expected eq '5a4d8ba7f519c84f') {print "ok 24\n"} else { warn "Expected *5a4d8ba7f519c84f*, got *$expected*\n"; print "not ok 24\n"; } $expected = Math::MPFR::bytes('1e+127', 'Double'); if($expected eq '5a4d8ba7f519c84f') {print "ok 25\n"} else { warn "Expected *5a4d8ba7f519c84f*, got *$expected*\n"; print "not ok 25\n"; } eval {$expected = Math::MPFR::bytes($ld_fr, 'Long Double');}; if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 26\n"} elsif($@) { warn "\$\@: $@\n"; print "not ok 26\n"; } elsif($expected eq '41a4ec5d3fa8ce427b00') {print "ok 26\n"} else { warn "Expected *41a4ec5d3fa8ce427b00*, got *$expected*\n"; print "not ok 26\n"; } eval {$expected = Math::MPFR::bytes('1e+127', 'Long Double');}; if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes does not match LDBL_MANT_DIG/) {print "ok 27\n"} elsif($@) { warn "\$\@: $@\n"; print "not ok 27\n"; } elsif($expected eq '41a4ec5d3fa8ce427b00') {print "ok 27\n"} else { warn "Expected *41a4ec5d3fa8ce427b00*, got *$expected*\n"; print "not ok 27\n"; } $expected = Math::MPFR::bytes($dd_fr, 'Double-Double'); if($expected eq '5a4d8ba7f519c84f56e7fd1f28f89c56') {print "ok 28\n"} else { warn "Expected *5a4d8ba7f519c84f56e7fd1f28f89c56*, got *$expected*\n"; print "not ok 28\n"; } $expected = Math::MPFR::bytes('1e+127', 'Double-Double'); if($expected eq '5a4d8ba7f519c84f56e7fd1f28f89c56') {print "ok 29\n"} else { warn "Expected *5a4d8ba7f519c84f56e7fd1f28f89c56*, got *$expected*\n"; print "not ok 29\n"; } eval{$expected = Math::MPFR::bytes($f128_fr, '__Float128');}; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 30\n"} else { warn "\n\$\@\: $@"; print "not ok 30\n"; } } elsif($@) { warn "\$\@:$@\n"; print "not ok 30\n"; } elsif($expected eq '41a4d8ba7f519c84f5ff47ca3e27156a') {print "ok 30\n"} else { warn "Expected *41a4d8ba7f519c84f5ff47ca3e27156a*, got *$expected*\n"; print "not ok 30\n"; } eval{$expected = Math::MPFR::bytes('1e+127', '__Float128');}; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 31\n"} else { warn "\n\$\@\: $@"; print "not ok 31\n"; } } elsif($@) { warn "\$\@:$@\n"; print "not ok 31\n"; } elsif($expected eq '41a4d8ba7f519c84f5ff47ca3e27156a') {print "ok 31\n"} else { warn "Expected *41a4d8ba7f519c84f5ff47ca3e27156a*, got *$expected*\n"; print "not ok 31\n"; } my $unity = Math::MPFR->new(1); Rmpfr_exp($d_fr, $unity, MPFR_RNDN); Rmpfr_exp($dd_fr, $unity, MPFR_RNDN); Rmpfr_exp($ld_fr, $unity, MPFR_RNDN); Rmpfr_exp($f128_fr, $unity, MPFR_RNDN); $expected = Math::MPFR::bytes($d_fr, 'double'); if($expected eq '4005bf0a8b145769') {print "ok 32\n"} else { warn "expected *4005bf0a8b145769*, got *$expected*\n"; print "not ok 32\n"; } $expected = Math::MPFR::bytes($dd_fr, 'Double-double'); if($expected eq '4005bf0a8b1457693ca4d57ee2b1013a') {print "ok 33\n"} else { warn "expected *4005bf0a8b1457693ca4d57ee2b1013a*, got *$expected*\n"; print "not ok 33\n"; } eval {$expected = Math::MPFR::bytes($ld_fr, 'Long double');}; if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 34\n"} elsif($@) { warn "\$\@: $@\n"; print "not ok 34\n"; } elsif($expected eq '4000adf85458a2bb4a9b') {print "ok 34\n"} else { warn "expected *4000adf85458a2bb4a9b*, got *$expected*\n"; print "not ok 34\n"; } eval{$expected = Math::MPFR::bytes($f128_fr, '__float128');}; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 35\n"} else { warn "\n\$\@\: $@"; print "not ok 35\n"; } } elsif($@) { warn "\$\@:$@\n"; print "not ok 35\n"; } elsif($expected eq '40005bf0a8b1457695355fb8ac404e7a') {print "ok 35\n"} else { warn "expected *40005bf0a8b1457695355fb8ac404e7a*, got *$expected*\n"; print "not ok 35\n"; } Rmpfr_const_pi($d_fr, MPFR_RNDN); Rmpfr_const_pi($dd_fr, MPFR_RNDN); Rmpfr_const_pi($ld_fr, MPFR_RNDN); Rmpfr_const_pi($f128_fr, MPFR_RNDN); $expected = Math::MPFR::bytes($d_fr, 'double'); if($expected eq '400921fb54442d18') {print "ok 36\n"} else { warn "expected *400921fb54442d18*, got *$expected*\n"; print "not ok 36\n"; } $expected = Math::MPFR::bytes($dd_fr, 'Double-double'); if($expected eq '400921fb54442d183ca1a62633145c07') {print "ok 37\n"} else { warn "expected *400921fb54442d183ca1a62633145c07*, got *$expected*\n"; print "not ok 37\n"; } eval {$expected = Math::MPFR::bytes($ld_fr, 'Long double');}; if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 38\n"} elsif($@) { warn "\$\@: $@\n"; print "not ok 38\n"; } elsif($expected eq '4000c90fdaa22168c235') {print "ok 38\n"} else { warn "expected *4000c90fdaa22168c235*, got *$expected*\n"; print "not ok 38\n"; } eval{$expected = Math::MPFR::bytes($f128_fr, '__float128');}; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 39\n"} else { warn "\n\$\@\: $@"; print "not ok 39\n"; } } elsif($@) { warn "\$\@:$@\n"; print "not ok 39\n"; } elsif($expected eq '4000921fb54442d18469898cc51701b8') {print "ok 39\n"} else { warn "expected *4000921fb54442d18469898cc51701b8*, got *$expected*\n"; print "not ok 39\n"; } Rmpfr_set_si($d_fr, 2, MPFR_RNDN); Rmpfr_set_si($dd_fr, 2, MPFR_RNDN); Rmpfr_set_si($ld_fr, 2, MPFR_RNDN); Rmpfr_set_si($f128_fr, 2, MPFR_RNDN); Rmpfr_sqrt($d_fr, $d_fr, MPFR_RNDN); Rmpfr_sqrt($dd_fr, $dd_fr, MPFR_RNDN); Rmpfr_sqrt($ld_fr, $ld_fr, MPFR_RNDN); Rmpfr_sqrt($f128_fr, $f128_fr, MPFR_RNDN); $expected = Math::MPFR::bytes($d_fr, 'double'); if($expected eq '3ff6a09e667f3bcd') {print "ok 40\n"} else { warn "expected *3ff6a09e667f3bcd*, got *$expected*\n"; print "not ok 40\n"; } $expected = Math::MPFR::bytes($dd_fr, 'Double-double'); if($expected eq '3ff6a09e667f3bcdbc9bdd3413b26456') {print "ok 41\n"} else { warn "expected *3ff6a09e667f3bcdbc9bdd3413b26456*, got *$expected*\n"; print "not ok 41\n"; } eval {$expected = Math::MPFR::bytes($ld_fr, 'Long double');}; if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 42\n"} elsif($@) { warn "\$\@: $@\n"; print "not ok 42\n"; } elsif($expected eq '3fffb504f333f9de6484') {print "ok 42\n"} else { warn "expected *3fffb504f333f9de6484*, got *$expected*\n"; print "not ok 42\n"; } eval{$expected = Math::MPFR::bytes($f128_fr, '__float128');}; if(!Math::MPFR::_MPFR_WANT_FLOAT128()) { if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 43\n"} else { warn "\n\$\@\: $@"; print "not ok 43\n"; } } elsif($@) { warn "\$\@:$@\n"; print "not ok 43\n"; } elsif($expected eq '3fff6a09e667f3bcc908b2fb1366ea95') {print "ok 43\n"} else { warn "expected *3fff6a09e667f3bcc908b2fb1366ea95*, got *$expected*\n"; print "not ok 43\n"; } __END__ e: 4005bf0a8b145769 4000adf85458a2bb4a9b 4005bf0a8b1457693ca4d57ee2b1013a 40005bf0a8b1457695355fb8ac404e7a pi: 400921fb54442d18 4000c90fdaa22168c235 400921fb54442d183ca1a62633145c07 4000921fb54442d18469898cc51701b8 sqrt(2): 3ff6a09e667f3bcd 3fffb504f333f9de6484 3ff6a09e667f3bcdbc9bdd3413b26456 3fff6a09e667f3bcc908b2fb1366ea95 Math-MPFR-3.32/t/constants.t0000644000076400010400000000222212660557734017225 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..6\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $version = RMPFR_VERSION_NUM(MPFR_VERSION_MAJOR, MPFR_VERSION_MINOR, MPFR_VERSION_PATCHLEVEL); if($version == MPFR_VERSION) {print "ok 1\n"} else { print "not ok 1 $version ", MPFR_VERSION, "\n"; } if(MPFR_VERSION_MAJOR >= 2) {print "ok 2\n"} else {print "not ok 2 MPFR_VERSION_MAJOR is ", MPFR_VERSION_MAJOR, "\n"} if(MPFR_VERSION_MINOR >= 2 || MPFR_VERSION_MAJOR >= 3) {print "ok 3\n"} else {print "not ok 3 MPFR_VERSION_MINOR is ", MPFR_VERSION_MINOR, " MPFR_VERSION_MAJOR is ", MPFR_VERSION_MAJOR, "\n"} if(MPFR_VERSION_PATCHLEVEL >= 0) {print "ok 4\n"} else {print "not ok 4 MPFR_VERSION_PATCHLEVEL is ", MPFR_VERSION_PATCHLEVEL, "\n"} my $v = Rmpfr_get_version(); if($v eq MPFR_VERSION_STRING) {print "ok 5\n"} else {print "not ok 5 $v is not the same as ", MPFR_VERSION_STRING, "\n"} eval{my $patches = Rmpfr_get_patches();}; if(!$@) {print "ok 6\n"} else {print "not ok 6 $@\n"} Math-MPFR-3.32/t/D64_LD.t0000644000076400010400000000543612660557734016137 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw (:mpfr); my $t = 3; print "1..$t\n"; my $why; my $keep_printing = 1; eval {require Math::Decimal64; Math::Decimal64->import (qw(:all));}; if($@) {$why = "Couldn't load Math::Decimal64\n"} else {$why = "Math::MPFR not built for _Decimal64\n" unless Math::MPFR::_MPFR_WANT_DECIMAL_FLOATS()} eval {require Math::LongDouble; Math::LongDouble->import (qw(:all));}; if($@) {$why .= "Couldn't load Math::LongDouble\n"} unless($why) { my $d64_1 = Math::Decimal64->new(0); my $d64_2 = Math::Decimal64->new(0); my $ld = ZeroLD(1); my $ok = 1; my $round = 0;# MPFR_RNDN my $mant_dig = Math::MPFR::_LDBL_MANT_DIG(); # expected to be either 64 or 106 Rmpfr_set_default_prec($mant_dig); # If $mant_dig == 106, I assume the long double is "double-double" - which doesn't # accommodate the full exponent range of the Decimal64 type. my $rand_limit = $mant_dig == 106 ? 292 : 399; for my $it (1..100000) { my $digits = 1 + int(rand(16)); # Don't exceed max precision for this test. #Rmpfr_set_default_prec(53 + int(rand(100))); my $man_sign = $it % 2 ? '-' : ''; my $exp_sign = $it % 3 ? 1 : -1; my $man = $man_sign . get_man($digits); my $exp = int(rand($rand_limit)) * $exp_sign; #next if $exp + $digits > 385; my $fr_arg = $man . '@' . $exp; my $d64_check = Math::Decimal64->new($man, $exp); my $fr = Math::MPFR->new($fr_arg, 10); Rmpfr_get_DECIMAL64($d64_1, $fr, $round); Rmpfr_get_LD($ld, $fr, $round); LDtoD64($d64_2, $ld); unless($d64_2 == $d64_1) { if($keep_printing < 6) { warn "$digits $exp\n$fr_arg\n $fr\n"; warn "\$d64_check: $d64_check\n\$d64_1: $d64_1\n\$d64_2: $d64_2\n\$ld: $ld\n\n"; $ok = 0; } $keep_printing++; } } if($ok) {print "ok 1\n"} else {print "not ok 1\n"} $ok = 1; for(3 .. 70) { my $eps = Math::Decimal64->new(1, -398); my $eps_ret = NVtoD64(2.5); my $eps_fr = Rmpfr_init2($_); Rmpfr_set_DECIMAL64($eps_fr, $eps, MPFR_RNDN); Rmpfr_get_DECIMAL64($eps_ret, $eps_fr, MPFR_RNDN); unless($eps_ret == $eps) { warn "\nMPFR precision: ", Rmpfr_get_prec($eps_fr), "\n"; warn "\$eps: $eps\n\$eps_ret: $eps_ret\n"; $ok = 0; } } if($ok) {print "ok 2\n"} else {print "not ok 2\n"} Rmpfr_set_default_prec($mant_dig); my $root = Math::MPFR->new(2.0); Rmpfr_sqrt($root, $root, MPFR_RNDN); my $ld_root = sqrt(Math::LongDouble->new(2.0)); Rmpfr_get_LD($ld, $root, MPFR_RNDN); if($ld == $ld_root) {print "ok 3\n"} else { warn "\n\$ld: $ld\n\$ld_root: $ld_root\n"; print "not ok 3\n"; } } else { warn "\nSkipping all tests\n"; warn $why; for (1 .. $t) {print "ok $_\n"} } sub get_man { my $ret = ''; for(1 .. $_[0]) {$ret .= int(rand(10))} return $ret; } Math-MPFR-3.32/t/decimal64_conv.t0000644000076400010400000001315112660557734020011 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); my $t = 21; print "1..$t\n"; eval {require Math::Decimal64; Math::Decimal64->import (qw(:all));}; my $why; if($@) { $why = "Couldn't load Math::Decimal64\n"; warn "\n Skipping all tests: $why: $@\n"; print "ok $_\n" for 1..$t; exit 0; } my $proceed = Math::MPFR::_MPFR_WANT_DECIMAL_FLOATS(); if($proceed) { Rmpfr_set_default_prec(55); # Using complementary Rounding Modes needs prec of 55. my $ok = 1; my $it; for $it(1 .. 10000) { my $nv = rand(1024) / (1 + rand(1024)); #$ $larg_1 and $larg_2 will be complementary Rounding modes. my $larg_1 = int(rand(5)); my $larg_2 = $larg_1 ? 5 - $larg_1 : $larg_1; my $d64_1 = NVtoD64($nv); my $fr_1 = Math::MPFR->new(); Rmpfr_set_DECIMAL64($fr_1, $d64_1, $larg_1); my $d64_2 = NVtoD64(0); Rmpfr_get_DECIMAL64($d64_2, $fr_1, $larg_2); unless($d64_1 == $d64_2) { $ok = 0; warn "$it: $d64_1 != $d64_2\n $larg_1 : $larg_2\n\n"; } } if($ok) {print "ok 1\n"} else {print "not ok 1\n"} $ok = 1; Rmpfr_set_default_prec(55); for $it(1 .. 10000) { my $nv = rand(1024) / (1 + rand(1024)); my $d64_1 = NVtoD64($nv); my $fr_1 = Math::MPFR->new(); Rmpfr_set_DECIMAL64($fr_1, $d64_1, 0); my $d64_2 = NVtoD64(0); Rmpfr_get_DECIMAL64($d64_2, $fr_1, 0); unless($d64_1 == $d64_2) { $ok = 0; warn "$it: $d64_1 != $d64_2\n"; } } if($ok) {print "ok 2\n"} else {print "not ok 2\n"} my $nanD64 = NaND64(); my $pinfD64 = InfD64(1); my $ninfD64 = InfD64(-1); my $zeroD64 = ZeroD64(1); my $nzeroD64 = ZeroD64(-1); my $rop = Math::Decimal64->new(); my $fr = Math::MPFR->new(); Rmpfr_set_DECIMAL64($fr, $nanD64, MPFR_RNDN); Rmpfr_get_DECIMAL64($rop, $fr, MPFR_RNDN); if(is_NaND64($rop)) {print "ok 3\n"} else { warn "\$rop: $rop\n"; print "not ok 3\n"; } Rmpfr_set_DECIMAL64($fr, $pinfD64, MPFR_RNDN); Rmpfr_get_DECIMAL64($rop, $fr, MPFR_RNDN); if(is_InfD64($rop) > 0) {print "ok 4\n"} else { warn "\$rop: $rop\n"; print "not ok 4\n"; } Rmpfr_set_DECIMAL64($fr, $ninfD64, MPFR_RNDN); Rmpfr_get_DECIMAL64($rop, $fr, MPFR_RNDN); if(is_InfD64($rop) < 0) {print "ok 5\n"} else { warn "\$rop: $rop\n"; print "not ok 5\n"; } Rmpfr_set_DECIMAL64($fr, $zeroD64, MPFR_RNDN); Rmpfr_get_DECIMAL64($rop, $fr, MPFR_RNDN); if(is_ZeroD64($rop) > 0) {print "ok 6\n"} else { warn "\$rop: $rop\n"; print "not ok 6\n"; } Rmpfr_set_DECIMAL64($fr, $nzeroD64, MPFR_RNDN); Rmpfr_get_DECIMAL64($rop, $fr, MPFR_RNDN); if(is_ZeroD64($rop) < 0) {print "ok 7\n"} else { warn "\$rop: $rop\n"; print "not ok 7\n"; } my $bigpos = Math::MPFR->new('1@385'); my $bigneg = $bigpos * -1; Rmpfr_get_DECIMAL64($rop, $bigpos, MPFR_RNDN); if(is_InfD64($rop) > 0) {print "ok 8\n"} else { warn "\n\$rop: $rop\n"; print "not ok 8\n"; } Rmpfr_get_DECIMAL64($rop, $bigneg, MPFR_RNDN); if(is_InfD64($rop) < 0) {print "ok 9\n"} else { warn "\n\$rop: $rop\n"; print "not ok 9\n"; } Rmpfr_get_DECIMAL64($rop, $bigpos, MPFR_RNDZ); if($rop == Math::Decimal64->new('9999999999999999','369')) {print "ok 10\n"} else { warn "\n\$rop: $rop\n"; print "not ok 10\n"; } if($rop == Math::Decimal64->new('9999999999999999','369')) {print "ok 11\n"} else { warn "\n\$rop: $rop\n"; print "not ok 11\n"; } if($rop == Math::Decimal64::DEC64_MAX()) {print "ok 12\n"} else { warn "\n\$rop: $rop\n"; print "not ok 12\n"; } my $littlepos = Math::MPFR->new('1@-399'); my $littleneg = $littlepos * -1; Rmpfr_get_DECIMAL64($rop, $littlepos, MPFR_RNDZ); if(is_ZeroD64($rop) > 0) {print "ok 13\n"} else { warn "\n\$rop: $rop\n"; print "not ok 13\n"; } Rmpfr_get_DECIMAL64($rop, $littleneg, MPFR_RNDZ); if(is_ZeroD64($rop) < 0) {print "ok 14\n"} else { warn "\n\$rop: $rop\n"; print "not ok 14\n"; } Rmpfr_get_DECIMAL64($rop, $littlepos, MPFR_RNDA); if($rop == Math::Decimal64->new(1, -398)) {print "ok 15\n"} else { warn "\n\$rop: $rop\n"; print "not ok 15\n"; } Rmpfr_get_DECIMAL64($rop, $littleneg, MPFR_RNDA); if($rop == Math::Decimal64->new(-1, -398)) {print "ok 16\n"} else { warn "\n\$rop: $rop\n"; print "not ok 16\n"; } if($rop == Math::Decimal64::DEC64_MIN() * Math::Decimal64::UnityD64(-1)) {print "ok 17\n"} else { warn "\n\$rop: $rop\n"; print "not ok 17\n"; } my $fr_d64 = Rmpfr_init2(55); my $d64_1 = MEtoD64('1', -298); my $d64_2 = Math::Decimal64->new(); Rmpfr_set_DECIMAL64($fr_d64, $d64_1, MPFR_RNDN); Rmpfr_get_DECIMAL64($d64_2, $fr_d64, MPFR_RNDN); if($d64_1 == $d64_2) {print "ok 18\n"} else { warn "\n $d64_1: $d64_1\n \$d64_2: $d64_2\n"; print "not ok 18\n"; } $d64_1 = NVtoD64(1e-298); Rmpfr_set_DECIMAL64($fr_d64, $d64_1, MPFR_RNDN); Rmpfr_get_DECIMAL64($d64_2, $fr_d64, MPFR_RNDN); if($d64_1 == $d64_2) {print "ok 19\n"} else { warn "\n $d64_1: $d64_1\n \$d64_2: $d64_2\n"; print "not ok 19\n"; } $d64_1 = MEtoD64('1', -360); Rmpfr_set_DECIMAL64($fr_d64, $d64_1, MPFR_RNDN); Rmpfr_get_DECIMAL64($d64_2, $fr_d64, MPFR_RNDN); if($d64_1 == $d64_2) {print "ok 20\n"} else { warn "\n $d64_1: $d64_1\n \$d64_2: $d64_2\n"; print "not ok 20\n"; } $d64_1 = NVtoD64(1e-360); Rmpfr_set_DECIMAL64($fr_d64, $d64_1, MPFR_RNDN); Rmpfr_get_DECIMAL64($d64_2, $fr_d64, MPFR_RNDN); if($d64_1 == $d64_2) {print "ok 21\n"} else { warn "\n $d64_1: $d64_1\n \$d64_2: $d64_2\n"; print "not ok 21\n"; } } else { warn "Skipping all tests - Math::MPFR not built for Decimal64 support"; print "ok $_\n" for 1..$t; } Math-MPFR-3.32/t/div_by_zero.t0000644000076400010400000001074212660557734017532 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..3\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $ok; my($have_mpz, $have_mpq, $have_gmp) = (0, 0, 0); eval{require Math::GMPz;}; unless($@) {$have_mpz = 1} eval{require Math::GMPq;}; unless($@) {$have_mpq = 1} eval{require Math::GMP;}; unless($@) {$have_gmp = 1} my($q_zero, $z_zero); # Rmpfr_div # Rmpfr_div_d Rmpfr_div_q Rmpfr_div_si Rmpfr_div_ui Rmpfr_div_z # Rmpfr_si_div Rmpfr_ui_div Rmpfr_d_div my $unity = Math::MPFR->new(1); my $rop = Math::MPFR->new(); my $fr_zero = Math::MPFR->new(0); if($have_gmp) {$z_zero = Math::GMP->new(0)} if($have_mpz && !$have_gmp) {$z_zero = Math::GMPz->new(0)} if($have_mpq) {$q_zero = Math::GMPq->new(0)} if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) { unless(Rmpfr_divby0_p()) {$ok .= 'a'} Rmpfr_set_divby0(); if(Rmpfr_divby0_p()) {$ok .= 'b'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'c'} Rmpfr_set_divby0(); if(Rmpfr_divby0_p()) {$ok .= 'd'} Rmpfr_clear_flags(); unless(Rmpfr_divby0_p()) {$ok .= 'e'} if($ok eq 'abcde') {print "ok 1\n"} else { warn "1: \$ok: $ok\n"; print "not ok 1\n"; } $ok = ''; Rmpfr_div($rop, $unity, $fr_zero, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'a'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'b'} if($have_gmp || $have_mpz) { Rmpfr_div_z($rop, $unity, $z_zero, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'c'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'd'} } else { warn "Skipping tests 2c and 2d - no Math::GMP or Math::GMPz\n"; $ok .= 'cd'; } if($have_mpq) { Rmpfr_div_q($rop, $unity, $q_zero, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'e'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'f'} } else { warn "Skipping tests 2e and 2f - no Math::GMPq\n"; $ok .= 'ef'; } Rmpfr_div_ui($rop, $unity, 0, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'g'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'h'} Rmpfr_div_si($rop, $unity, 0, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'i'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'j'} Rmpfr_div_d($rop, $unity, 0.0, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'k'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'l'} Rmpfr_ui_div($rop, 15, $fr_zero, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'm'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'n'} Rmpfr_si_div($rop, -23, $fr_zero, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'o'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'p'} Rmpfr_d_div($rop, 12.34, $fr_zero, GMP_RNDN); if(Rmpfr_divby0_p()) {$ok .= 'q'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'r'} if($ok eq 'abcdefghijklmnopqr') {print "ok 2\n"} else { warn "2: \$ok: $ok\n"; print "not ok 2\n"; } $ok = ''; $rop = $unity / $fr_zero; if(Rmpfr_divby0_p()) {$ok .= 'a'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'b'} $rop = $unity / 0; if(Rmpfr_divby0_p()) {$ok .= 'c'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'd'} $rop = $unity / 0.0; if(Rmpfr_divby0_p()) {$ok .= 'e'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'f'} $rop = $unity / '0.0'; if(Rmpfr_divby0_p()) {$ok .= 'g'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'h'} $rop = 1 / $fr_zero; if(Rmpfr_divby0_p()) {$ok .= 'i'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'j'} $rop = -1 / $fr_zero; if(Rmpfr_divby0_p()) {$ok .= 'k'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'l'} $rop = 12.34 / $fr_zero; if(Rmpfr_divby0_p()) {$ok .= 'm'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'n'} $rop = '12.34' / $fr_zero; if(Rmpfr_divby0_p()) {$ok .= 'o'} Rmpfr_clear_divby0(); unless(Rmpfr_divby0_p()) {$ok .= 'p'} if($ok eq 'abcdefghijklmnop') {print "ok 3\n"} else { warn "3: \$ok: $ok\n"; print "not ok 3\n"; } } else { eval{Rmpfr_set_divby0();}; if($@ =~ /Rmpfr_set_divby0 not implemented/) {print "ok 1\n"} else {print "not ok 1\n"} eval{Rmpfr_clear_divby0();}; if($@ =~ /Rmpfr_clear_divby0 not implemented/) {print "ok 2\n"} else {print "not ok 2\n"} eval{Rmpfr_divby0_p();}; if($@ =~ /Rmpfr_divby0_p not implemented/) {print "ok 3\n"} else {print "not ok 3\n"} } Math-MPFR-3.32/t/DoubleDouble.t0000644000076400010400000003417312660557734017570 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); #use Math::NV qw(:all); my $test_nv1 = 1.0; my $test_nv2 = $test_nv1 + (2 ** -1000); if($test_nv2 > $test_nv1 && Math::MPFR::_has_longdouble()) { my $t = 266; print "1..$t\n"; Rmpfr_set_default_prec(2098); my $nv = (2 ** 100) + (2 ** -1060) + (2 ** -1068) + (2 ** -1074); my $fr = Math::MPFR->new($nv); if($nv == $fr) {print "ok 1\n"} else { warn "\n\$nv: $nv\n\$fr: $fr\n"; print "not ok 1\n"; } if($fr > 2 ** 100) { print "ok 2\n"} else {print "not ok 2\n"} if(!Rmpfr_cmp_ld($fr, $nv)) {print "ok 3\n"} else { warn "\n\$nv: $nv\n\$fr: $fr\n"; print "not ok 3\n"; } my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv_redone == $nv) { print "ok 4\n"; } else { warn "\n\$nv: $nv\n\$nv_redone: $nv_redone\n"; print "not ok 4\n"; } my $nv_redone2 = Rmpfr_get_NV($fr, MPFR_RNDN); if($nv_redone2 == $nv) { print "ok 5\n"; } else { warn "\n\$nv: $nv\n\$nv_redone: $nv_redone\n"; print "not ok 5\n"; } my $fr2 = Math::MPFR->new($nv + (2 ** 100)); if(Rmpfr_cmp_ld($fr2, $nv) > 0) {print "ok 6\n"} else { warn "\n\$fr: $fr\n\$fr2: $fr2\n"; print "not ok 6\n"; } my $set_test = Rmpfr_init(); my $ret = Rmpfr_set_ld($set_test, $nv, MPFR_RNDN); if(!$ret) {print "ok 7\n"} else { warn "\n\$ret: $ret\n"; print "not ok 7\n"; } my @variants = (1,2,3,4); $t = 7; # Tests 8-11 follow: ################################# for my $v(@variants) { my($ok, $count) = (1, 0); $t++; my @curr; @curr = ('-', '-') if $v == 1; @curr = ('+', '-') if $v == 2; @curr = ('-', '+') if $v == 3; @curr = ('+', '+') if $v == 4; ################################# for my $exp(0..10, 20, 30, 280 .. 308) { for my $digits(1..31) { my $str = $curr[0] . random_select($digits) . 'e' . $curr[1] . "$exp"; my $nv = $str * 1.0; my $fr = Math::MPFR->new(); my $tern = Rmpfr_set_ld($fr, $nv, MPFR_RNDN); #print "$nv "; if($tern) { warn "\n$str: $str \$tern: $tern\n" unless $count > 5; $ok = 0; $count++; } if($nv != $fr) { warn "\n$str: $str \$nv: $nv \$fr: $fr\n" unless $count > 5; $ok = 0; $count++; } my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv != $nv_redone) { warn "\n$str: $str \$nv: $nv \$nv_redone: $nv_redone\n" unless $count > 5; $ok = 0; $count++; } } } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} } ################################# for my $v(@variants) { my($ok, $count) = (1, 0); $t++; my @curr; @curr = ('-', '-') if $v == 1; @curr = ('+', '-') if $v == 2; @curr = ('-', '+') if $v == 3; @curr = ('+', '+') if $v == 4; ################################# for my $exp(0..10, 20, 30, 280 .. 308) { for my $digits(1..31) { my $str = $curr[0] . '0.' . random_select($digits) . 'e' . $curr[1] . "$exp"; my $nv = $str * 1.0; my $fr = Math::MPFR->new(); my $tern = Rmpfr_set_ld($fr, $nv, MPFR_RNDN); if($tern) { warn "\n$str: $str \$tern: $tern\n" unless $count > 5; $ok = 0; $count++; } if($nv != $fr) { warn "\n$str: $str \$nv: $nv \$fr: $fr\n" unless $count > 5; $ok = 0; $count++; } my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv != $nv_redone) { warn "\n$str: $str \$nv: $nv \$nv_redone: $nv_redone\n" unless $count > 5; $ok = 0; $count++; } } } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} } Rmpfr_set_default_prec(106); $t = 16; for(-305 .. -293) { my $str = "1e$_"; my $f1 = Math::MPFR->new($str); my $nv = $str * 1.0; #my $nv = nv($str); my $f2 = Math::MPFR->new($nv); if($f1 != $f2) {print "ok $t\n"} else { warn "\n$str: \$f1 == \$f2\n"; Rmpfr_dump($f1); Rmpfr_dump($f2); print "not ok $t\n"; } $t++; if($f1 != $nv) {print "ok $t\n"} else { warn "\n$str: \$f1 == \$nv\n"; print "not ok $t\n"; } $t++; if($f2 == $nv) {print "ok $t\n"} else { warn "\n$str: \$f2 != $nv\n"; print "not ok $t\n"; } $t++; my $n1 = Rmpfr_get_ld($f1, MPFR_RNDN); my $n2 = Rmpfr_get_ld($f2, MPFR_RNDN); if($n1 == $nv) {print "ok $t\n"} else { $n1 > $nv ? warn "\n$str: \$n1 is greater than \$nv\n" : warn "\n$str: \$n1 is less than \$nv\n"; print "not ok $t\n"; } $t++; if($n2 == $nv) {print "ok $t\n"} else { $n2 > $nv ? warn "\n$str: \$n2 is greater than \$nv\n" : warn "\n$str: \$n2 is less than \$nv\n"; print "not ok $t\n"; } $t++; } #Rmpfr_dump($f1); #Rmpfr_dump($f2); Rmpfr_set_default_prec(2098); $t--; # Otherwise we don't run a test 81 # Tests 81-88 follow for my $exp(298 .. 304) { $t++; my $ok = 1; my $str = '0.0000000009' . "e-$exp"; my $nv = $str * 1.0; my $fr = Math::MPFR->new(); my $tern = Rmpfr_set_ld($fr, $nv, MPFR_RNDN); if($tern) { warn "\n$str: Rmpfr_set_ld returned true\n"; $ok = 0; } if($fr != $nv) { warn "\n$str: \$fr != \$nv\n"; $ok = 0; } my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv != $nv_redone) { warn "\n$str: \$nv != \$nv_redone\n"; $ok = 0; } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} } # Tests 89-95 follow: Rmpfr_set_default_prec(106); for my $exp(298 .. 304) { $t++; my $ok = 1; my $str = '0.0000000009' . "e-$exp"; my $nv = $str * 1.0; my $fr = Math::MPFR->new($nv); my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv != $nv_redone) { warn "\n$str: \$nv != \$nv_redone\n"; $ok = 0; } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} } my($nv1, $nv2, $nv3, $nv4) = (2 ** 1023, 2 ** 1000, 2 ** - 1074, 2 ** -1054); @variants = (1, 2, 3, 4); # Tests 96-99 follow: ################################# for my $v(@variants) { my($ok, $count) = (1, 0); $t++; my @curr; @curr = ('-1', '-1') if $v == 4; @curr = ('+1', '-1') if $v == 2; @curr = ('-1', '+1') if $v == 3; @curr = ('+1', '+1') if $v == 1; ################################# my $nv = ($nv2 + ($nv1 * $curr[0])) + ($nv4 + ($nv3 * $curr[1])); my $fr = Rmpfr_init(); my $tern = Rmpfr_set_ld($fr, $nv, MPFR_RNDN); if(!$tern) { warn "\n@curr: Rmpfr_set_ld returned 0\n"; $ok = 0; } if($fr == $nv) { warn "\n@curr: \$fr == $nv\n"; $ok = 0; } my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv == $nv_redone) { warn "\n@curr: NV's match"; $ok = 0; } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} ############################# } # Close "for(@variants)" loop ############################# # Tests 100-103 follow: ################################# for my $v(@variants) { my($ok, $count) = (1, 0); $t++; my @curr; @curr = ('-1', '-1') if $v == 4; @curr = ('+1', '-1') if $v == 2; @curr = ('-1', '+1') if $v == 3; @curr = ('+1', '+1') if $v == 1; ################################# my $nv = ($nv2 + ($nv1 * $curr[0])) - ($nv4 + ($nv3 * $curr[1])); my $fr = Rmpfr_init(); my $tern = Rmpfr_set_ld($fr, $nv, MPFR_RNDN); if(!$tern) { warn "\n@curr: Rmpfr_set_ld returned 0\n"; $ok = 0; } if($fr == $nv) { warn "\n@curr: \$fr == $nv\n"; $ok = 0; } my $nv_redone = Rmpfr_get_ld($fr, MPFR_RNDN); if($nv == $nv_redone) { warn "\n@curr: NV's match"; $ok = 0; } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} ############################# } # Close "for(@variants)" loop ############################# my @case1 = ('9007199254740991.01', '9007199254740991.04', '9007199254740991.05', '9007199254740991.06', '9007199254740991.09', '9007199254740991.02', '9007199254740991.03', '9007199254740991.07', '9007199254740991.08', '9007199254740991.11', '9007199254740991.14', '9007199254740991.15', '9007199254740991.16', '9007199254740991.10', '9007199254740991.12', '9007199254740991.13', '9007199254740991.17', '9007199254740991.19', '9007199254740991.41', '9007199254740991.44', '9007199254740991.45', '9007199254740991.46', '9007199254740991.40', '9007199254740991.42', '9007199254740991.43', '9007199254740991.48', '9007199254740991.49', '9007199254740991.4999999', '9007199254740991.50', '9007199254740991.51', '9007199254740991.55', '9007199254740991.56', '9007199254740991.52', '9007199254740991.53', '9007199254740991.57', '9007199254740991.58', '9007199254740991.59', '9007199254740991.61', '9007199254740991.64', '9007199254740991.65', '9007199254740991.66', '9007199254740991.69', '9007199254740991.91', '9007199254740991.94', '9007199254740991.95', '9007199254740991.96', '9007199254740991.90', '9007199254740991.94999999', '9007199254740991.92', '9007199254740991.93', '9007199254740991.99', ); my @case2 = ('9007199254740990.01', '9007199254740990.04', '9007199254740990.05', '9007199254740990.06', '9007199254740990.09', '9007199254740990.11', '9007199254740990.14', '9007199254740990.15', '9007199254740990.16', '9007199254740990.19', '9007199254740990.41', '9007199254740990.44', '9007199254740990.45', '9007199254740990.46', '9007199254740990.49', '9007199254740990.50', '9007199254740990.51', '9007199254740990.55', '9007199254740990.56', '9007199254740990.59', '9007199254740990.61', '9007199254740990.64', '9007199254740990.65', '9007199254740990.66', '9007199254740990.69', '9007199254740990.91', '9007199254740990.94', '9007199254740990.95', '9007199254740990.96', '9007199254740990.99', ); my @case3 = ('4503599627370495.01', '4503599627370495.04', '4503599627370495.05', '4503599627370495.06', '4503599627370495.09', '4503599627370495.11', '4503599627370495.14', '4503599627370495.15', '4503599627370495.16', '4503599627370495.19', '4503599627370495.41', '4503599627370495.44', '4503599627370495.45', '4503599627370495.46', '4503599627370495.49', '4503599627370495.50', '4503599627370495.51', '4503599627370495.55', '4503599627370495.56', '4503599627370495.59', '4503599627370495.61', '4503599627370495.64', '4503599627370495.65', '4503599627370495.66', '4503599627370495.69', '4503599627370495.91', '4503599627370495.94', '4503599627370495.95', '4503599627370495.96', '4503599627370495.99', ); Rmpfr_set_default_prec(2098); # Tests 104-214 follow for my $str (@case1, @case2, @case3) { $t++; my $ok = 1; my $nv = $str + 0; my $fr = Rmpfr_init(); my $tern = Rmpfr_set_ld($fr, $nv, MPFR_RNDN); if($tern) { warn "\n$str: Rmpfr_set_ld returned $tern\n"; $ok = 0; } if($fr != $nv) { warn "\n$str: \$fr != \$nv\n"; $ok = 0; } my $nv_redone = Rmpfr_get_NV($fr, MPFR_RNDN); if($nv != $nv_redone) { warn "\n$str: \$nv != \$nv_redone\n"; $ok = 0; } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} } # For double-doubles less than 2**-1021, 53-bits of precision and 2098 bits of precison should # both store the same value. my $fr_53 = Rmpfr_init2(53); my $fr_53_next = Rmpfr_init2(53); Rmpfr_set_ld($fr_53, 0.0, MPFR_RNDN); Rmpfr_set_ld($fr_53_next, 0.0, MPFR_RNDN); my $fr_2098 = Math::MPFR->new(); my $fr_2098_next = Math::MPFR->new(0); my $ld_53_next = 0; my $ld_2098_next = 0; # Tests 215-267 follow: for(-1074 .. -1022) { $t++; my $ok = 1; my $tern = Rmpfr_set_ld($fr_53, 2 ** $_, MPFR_RNDN); if($tern) { warn "\n$_: Rmpfr_set_ld to 53 bits returned true\n"; $ok = 0; } $tern = Rmpfr_set_ld($fr_2098, 2 ** $_, MPFR_RNDN); if($tern) { warn "\n$_: Rmpfr_set_ld to 53 bits returned true\n"; $ok = 0; } if($fr_53 != $fr_2098) { warn "\n$_: \$fr_53 and \$fr_2098 are not equal\n"; $ok = 0; } $fr_53_next += $fr_53; unless($fr_53_next > $fr_2098_next && $fr_2098_next < $fr_53_next) { warn "\n$_: \$fr_53_next/\$fr_2098_next anomaly\n"; $ok = 0; } unless($fr_53_next > $ld_53_next && $ld_53_next < $fr_53_next) { warn "\n$_: \$fr_53_next/\$ld_53_next anomaly\n"; $ok = 0; } #Rmpfr_add($fr_53_next, $fr_53_next, $fr_53, MPFR_RNDN); $fr_2098_next += $fr_2098; #Rmpfr_add($fr_2098_next, $fr_2098_next, $fr_2098, MPFR_RNDN); if($fr_53_next != $fr_2098_next) { warn "\n$_: \$fr_53_next and \$fr_2098_next are not equal\n"; $ok = 0; } #Rmpfr_dump($fr_53_next); #Rmpfr_dump($fr_2098_next); #exit 0; my $ld_53 = Rmpfr_get_ld($fr_53, MPFR_RNDN); if($ld_53 != $fr_53) { warn "\n$_: \$ld_53 != \$fr_53\n"; $ok = 0; } my $ld_2098 = Rmpfr_get_ld($fr_2098, MPFR_RNDN); if($ld_2098 != $fr_2098) { warn "\n$_: \$ld_2098 != \$fr_2098\n"; $ok = 0; } $ld_53_next += $ld_53; $ld_2098_next += $ld_2098; if($ld_53_next != $ld_2098_next) { warn "\n$_: \$ld_53_next != \$ld_2098_next\n"; $ok = 0; } if($ld_53_next != $fr_53_next) { warn "\n$_: \$ld_53_next != \$fr_53_next\n"; $ok = 0; } if($fr_2098_next != $ld_2098_next) { warn "\n$_: \$fr_2098_next != \$ld_2098_next\n"; $ok = 0; } if($ok) {print "ok $t\n"} else {print "not ok $t\n"} } ############## ############## } else { print "1..1\n"; warn "\nSkipping all tests - not a Double-Double build\n"; print "ok 1\n"; } ############################# ############################# sub random_select { my $ret = ''; for(1 .. $_[0]) { $ret .= int(rand(10)); } return $ret; } Math-MPFR-3.32/t/DoubleDouble2.t0000644000076400010400000000226512660557734017647 0ustar sisyphusAdministratorsuse warnings; use strict; use Config; use Math::MPFR qw(:mpfr); my $test_nv1 = 1.0; my $test_nv2 = $test_nv1 + (2 ** -1000); if($test_nv2 > $test_nv1 && Math::MPFR::_has_longdouble()) { print "1..3\n"; my $fr = Rmpfr_init2(106); Rmpfr_set_ld($fr, $test_nv2, MPFR_RNDN); if($fr == $test_nv2) {print "not ok 1\n"} else {print "ok 1\n"} my $check = Rmpfr_get_ld($fr, MPFR_RNDN); if($check == $test_nv2) {print "not ok 2\n"} else {print "ok 2\n"} if(Math::MPFR::_required_ldbl_mant_dig() == 2098) {print "ok 3\n"} else { warn "\n expected 2098, got ", Math::MPFR::_required_ldbl_mant_dig(), "\n"; print "not ok 3\n"; } } else { print "1..1\n"; warn "\nnot a Double-Double build.\nLDBL_MANT_DIG is ", Math::MPFR::_required_ldbl_mant_dig() == 2098 ? 106 : Math::MPFR::_required_ldbl_mant_dig() , "\n"; if(Math::MPFR::_required_ldbl_mant_dig() == 64 || Math::MPFR::_required_ldbl_mant_dig() == 2098 || Math::MPFR::_required_ldbl_mant_dig() == 113 || Math::MPFR::_required_ldbl_mant_dig() == 53 ) {print "ok 1\n"} else { warn "\n expected 2098, 64 or 53 - got ", Math::MPFR::_required_ldbl_mant_dig(), "\n"; print "not ok 1\n"; } } Math-MPFR-3.32/t/exceptions.t0000644000076400010400000000254112660557734017376 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); print "1..7\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $x = Rmpfr_init(); my $y = Rmpfr_init(); if(Rmpfr_underflow_p() || Rmpfr_overflow_p() || Rmpfr_inexflag_p() || Rmpfr_nanflag_p() || Rmpfr_erangeflag_p()) {print "not ok 1\n"} else {print "ok 1\n"} Rmpfr_add($y, $y, $y, GMP_RNDN); if(Rmpfr_nanflag_p()) {print "ok 2\n"} else {print "not ok 2\n"} Rmpfr_set_ui($x, 2, GMP_RNDN); Rmpfr_cos($x, $x, GMP_RNDN); if(Rmpfr_inexflag_p()) {print "ok 3\n"} else {print "not ok 3\n"} Rmpfr_set_ui($x, 1, GMP_RNDN); Rmpfr_mul_2exp($x, $x, 1024, GMP_RNDN); Rmpfr_get_ui($x, GMP_RNDN); if(Rmpfr_erangeflag_p()) {print "ok 4\n"} else {print "not ok 4\n"} Rmpfr_set_emin(-1020); Rmpfr_set_emax(1020); Rmpfr_set_ui($x, 1, GMP_RNDN); Rmpfr_mul_2exp($x, $x, 1025, GMP_RNDN); if(Rmpfr_overflow_p()) {print "ok 5\n"} else {print "not ok 5\n"} Rmpfr_set_ui($x, 1, GMP_RNDN); Rmpfr_div_2exp($x, $x, 1025, GMP_RNDN); if(Rmpfr_underflow_p()) {print "ok 6\n"} else {print "not ok 6\n"} Rmpfr_clear_flags(); if(Rmpfr_underflow_p() || Rmpfr_overflow_p() || Rmpfr_inexflag_p() || Rmpfr_nanflag_p() || Rmpfr_erangeflag_p()) {print "not ok 7\n"} else {print "ok 7\n"} Math-MPFR-3.32/t/flags.t0000644000076400010400000000257312660557734016316 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..2\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $ok = ''; Rmpfr_set_overflow(); if(Rmpfr_overflow_p()) {$ok .= 'a'} Rmpfr_clear_overflow(); if(!Rmpfr_overflow_p()) {$ok .= 'b'} Rmpfr_set_underflow(); if(Rmpfr_underflow_p()) {$ok .= 'c'} Rmpfr_clear_underflow(); if(!Rmpfr_underflow_p()) {$ok .= 'd'} Rmpfr_set_inexflag(); if(Rmpfr_inexflag_p()) {$ok .= 'e'} Rmpfr_clear_inexflag(); if(!Rmpfr_inexflag_p()) {$ok .= 'f'} Rmpfr_set_erangeflag(); if(Rmpfr_erangeflag_p()) {$ok .= 'g'} Rmpfr_clear_erangeflag(); if(!Rmpfr_erangeflag_p()) {$ok .= 'h'} Rmpfr_set_nanflag(); if(Rmpfr_nanflag_p()) {$ok .= 'i'} Rmpfr_clear_nanflag(); if(!Rmpfr_nanflag_p()) {$ok .= 'j'} if($ok eq 'abcdefghij') {print "ok 1\n"} else {print "not ok 1\n"} my $zero = Math::MPFR->new(0); my $inf = Math::MPFR->new(1); $ok = ''; $inf /= $zero; Rmpfr_clear_overflow(); if(!Rmpfr_overflow_p()) {$ok .= 'a'} Rmpfr_check_range($inf, 123, GMP_RNDN); if(Rmpfr_overflow_p()) {$ok .= 'b'} $inf *= -1; Rmpfr_clear_overflow(); if(!Rmpfr_overflow_p()) {$ok .= 'c'} Rmpfr_check_range($inf, 123, GMP_RNDN); if(Rmpfr_overflow_p()) {$ok .= 'd'} if($ok eq 'abcd') {print "ok 2\n"} else {print "not ok 2 $ok\n"} Math-MPFR-3.32/t/float128_conv.t0000644000076400010400000001411312660557734017600 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); my $t = 21; print "1..$t\n"; my $why; my $proceed = Math::MPFR::_MPFR_WANT_FLOAT128(); unless($proceed) { $why = "Math::MPFR built without float128 support\n"; warn "\n Skipping all tests: $why"; print "ok $_\n" for 1..$t; exit 0; } eval {require Math::Float128; Math::Float128->import (qw(:all));}; if($@) { $why = "Couldn't load Math::Float128\n"; warn "\n Skipping all tests: $why: $@\n"; print "ok $_\n" for 1..$t; exit 0; } if(196866 >= MPFR_VERSION) { $why = "No float128 support with this version of the mpfr library\n"; warn "\n Skipping all tests: $why"; print "ok $_\n" for 1..$t; exit 0; } if($proceed) { Rmpfr_set_default_prec(114); my $ok = 1; my $it; for $it(1 .. 10000) { my $nv = rand(1024) / (1 + rand(1024)); #$ $larg_1 and $larg_2 will be complementary Rounding modes. my $larg_1 = int(rand(5)); my $larg_2 = $larg_1 ? 5 - $larg_1 : $larg_1; my $f128_1 = NVtoF128($nv); my $fr_1 = Math::MPFR->new(); Rmpfr_set_FLOAT128($fr_1, $f128_1, $larg_1); my $f128_2 = NVtoF128(0); Rmpfr_get_FLOAT128($f128_2, $fr_1, $larg_2); unless($f128_1 == $f128_2) { $ok = 0; warn "$it: $f128_1 != $f128_2\n $larg_1 : $larg_2\n\n"; } } if($ok) {print "ok 1\n"} else {print "not ok 1\n"} $ok = 1; Rmpfr_set_default_prec(115); for $it(1 .. 10000) { my $nv = rand(1024) / (1 + rand(1024)); my $f128_1 = NVtoF128($nv); my $fr_1 = Math::MPFR->new(); Rmpfr_set_FLOAT128($fr_1, $f128_1, 0); my $f128_2 = NVtoF128(0); Rmpfr_get_FLOAT128($f128_2, $fr_1, 0); unless($f128_1 == $f128_2) { $ok = 0; warn "$it: $f128_1 != $f128_2\n"; } } if($ok) {print "ok 2\n"} else {print "not ok 2\n"} my $nanF128 = NaNF128(); my $pinfF128 = InfF128(1); my $ninfF128 = InfF128(-1); my $zeroF128 = ZeroF128(1); my $nzeroF128 = ZeroF128(-1); my $rop = Math::Float128->new(); my $fr = Math::MPFR->new(); Rmpfr_set_FLOAT128($fr, $nanF128, MPFR_RNDN); Rmpfr_get_FLOAT128($rop, $fr, MPFR_RNDN); if(is_NaNF128($rop)) {print "ok 3\n"} else { warn "\$rop: $rop\n"; print "not ok 3\n"; } Rmpfr_set_FLOAT128($fr, $pinfF128, MPFR_RNDN); Rmpfr_get_FLOAT128($rop, $fr, MPFR_RNDN); if(is_InfF128($rop) > 0) {print "ok 4\n"} else { warn "\$rop: $rop\n"; print "not ok 4\n"; } Rmpfr_set_FLOAT128($fr, $ninfF128, MPFR_RNDN); Rmpfr_get_FLOAT128($rop, $fr, MPFR_RNDN); if(is_InfF128($rop) < 0) {print "ok 5\n"} else { warn "\$rop: $rop\n"; print "not ok 5\n"; } Rmpfr_set_FLOAT128($fr, $zeroF128, MPFR_RNDN); Rmpfr_get_FLOAT128($rop, $fr, MPFR_RNDN); if(is_ZeroF128($rop) > 0) {print "ok 6\n"} else { warn "\$rop: $rop\n"; print "not ok 6\n"; } Rmpfr_set_FLOAT128($fr, $nzeroF128, MPFR_RNDN); Rmpfr_get_FLOAT128($rop, $fr, MPFR_RNDN); if(is_ZeroF128($rop) < 0) {print "ok 7\n"} else { warn "\$rop: $rop\n"; print "not ok 7\n"; } my $bigpos = Math::MPFR->new('1.4e4932'); my $bigneg = $bigpos * -1; Rmpfr_get_FLOAT128($rop, $bigpos, MPFR_RNDN); if(is_InfF128($rop) > 0) {print "ok 8\n"} else { warn "\n\$rop: $rop\n"; print "not ok 8\n"; } Rmpfr_get_FLOAT128($rop, $bigneg, MPFR_RNDN); if(is_InfF128($rop) < 0) {print "ok 9\n"} else { warn "\n\$rop: $rop\n"; print "not ok 9\n"; } Rmpfr_get_FLOAT128($rop, Math::MPFR->new('1.18973149535723176508575932662800702e4932'), MPFR_RNDZ); if($rop == Math::Float128->new('1.18973149535723176508575932662800702e4932')) {print "ok 10\n"} else { warn "\n\$rop: $rop\n"; print "not ok 10\n"; } if(-$rop == Math::Float128->new('-1.18973149535723176508575932662800702e4932')) {print "ok 11\n"} else { warn "\n\$rop: $rop\n"; print "not ok 11\n"; } if($rop == Math::Float128::FLT128_MAX()) {print "ok 12\n"} else { warn "\n\$rop: $rop\n"; print "not ok 12\n"; } my $littlepos = Math::MPFR->new('7e-4967'); my $littleneg = $littlepos * -1; Rmpfr_get_FLOAT128($rop, $littlepos, MPFR_RNDZ); if(is_ZeroF128($rop) > 0) {print "ok 13\n"} else { warn "\n\$rop: $rop\n"; print "not ok 13\n"; } Rmpfr_get_FLOAT128($rop, $littleneg, MPFR_RNDZ); if(is_ZeroF128($rop) < 0) {print "ok 14\n"} else { warn "\n\$rop: $rop\n"; print "not ok 14\n"; } Rmpfr_get_FLOAT128($rop, $littlepos, MPFR_RNDA); if(is_ZeroF128($rop) > 0) {print "ok 15\n"} else { warn "\n\$rop: $rop\n"; print "not ok 15\n"; } Rmpfr_get_FLOAT128($rop, $littleneg, MPFR_RNDA); if(is_ZeroF128($rop) < 0) {print "ok 16\n"} else { warn "\n\$rop: $rop\n"; print "not ok 16\n"; } Rmpfr_get_FLOAT128($rop, Math::MPFR->new('6.475175119438025110924438958227646552e-4966'), MPFR_RNDN); if($rop == Math::Float128::FLT128_DENORM_MIN()) {print "ok 17\n"} else { warn "\n\$rop: $rop\n"; print "not ok 17\n"; } my $fr_F128 = Rmpfr_init2(115); my $f128_1 = STRtoF128('1e-298'); my $f128_2 = Math::Float128->new(); Rmpfr_set_FLOAT128($fr_F128, $f128_1, MPFR_RNDN); Rmpfr_get_FLOAT128($f128_2, $fr_F128, MPFR_RNDN); if($f128_1 == $f128_2) {print "ok 18\n"} else { warn "\n $f128_1: $f128_1\n \$f128_2: $f128_2\n"; print "not ok 18\n"; } $f128_1 = NVtoF128(1e-298); Rmpfr_set_FLOAT128($fr_F128, $f128_1, MPFR_RNDN); Rmpfr_get_FLOAT128($f128_2, $fr_F128, MPFR_RNDN); if($f128_1 == $f128_2) {print "ok 19\n"} else { warn "\n $f128_1: $f128_1\n \$f128_2: $f128_2\n"; print "not ok 19\n"; } $f128_1 = STRtoF128('1e-360'); Rmpfr_set_FLOAT128($fr_F128, $f128_1, MPFR_RNDN); Rmpfr_get_FLOAT128($f128_2, $fr_F128, MPFR_RNDN); if($f128_1 == $f128_2) {print "ok 20\n"} else { warn "\n $f128_1: $f128_1\n \$f128_2: $f128_2\n"; print "not ok 20\n"; } $f128_1 = NVtoF128(1e-360); Rmpfr_set_FLOAT128($fr_F128, $f128_1, MPFR_RNDN); Rmpfr_get_FLOAT128($f128_2, $fr_F128, MPFR_RNDN); if($f128_1 == $f128_2) {print "ok 21\n"} else { warn "\n $f128_1: $f128_1\n \$f128_2: $f128_2\n"; print "not ok 21\n"; } } else { warn "Skipping all tests - Math::MPFR not built for Float128 support"; print "ok $_\n" for 1..$t; } Math-MPFR-3.32/t/grandom.t0000644000076400010400000000336712660557734016653 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..1\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $rop1 = Math::MPFR->new(); my $rop2 = Math::MPFR->new(); my $state1 = Rmpfr_randinit_default(); my $state2 = Rmpfr_randinit_lc_2exp('123456789123456789', 98765432123456789, 50); my $state3 = Rmpfr_randinit_lc_2exp_size(100); my $state4 = Rmpfr_randinit_mt(); Rmpfr_randseed($state1, '2345678909876543210'); Rmpfr_randseed($state2, '3456789098765432123'); Rmpfr_randseed_ui($state3, 12345678909); my $ok = ''; if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) { Rmpfr_grandom($rop1, $rop2, $state1, GMP_RNDN); if($rop1 && $rop2 && $rop1 != $rop2 && !Rmpfr_nan_p($rop1) && !Rmpfr_nan_p($rop2)) {$ok .= 'a'} #print "$rop1 $rop2\n"; Rmpfr_grandom($rop1, $rop2, $state2, GMP_RNDN); if($rop1 && $rop2 && $rop1 != $rop2 && !Rmpfr_nan_p($rop1) && !Rmpfr_nan_p($rop2)) {$ok .= 'b'} #print "$rop1 $rop2\n"; Rmpfr_grandom($rop1, $rop2, $state3, GMP_RNDN); if($rop1 && $rop2 && $rop1 != $rop2 && !Rmpfr_nan_p($rop1) && !Rmpfr_nan_p($rop2)) {$ok .= 'c'} #print "$rop1 $rop2\n"; Rmpfr_grandom($rop1, $rop2, $state4, GMP_RNDN); if($rop1 && $rop2 && $rop1 != $rop2 && !Rmpfr_nan_p($rop1) && !Rmpfr_nan_p($rop2)) {$ok .= 'd'} #print "$rop1 $rop2\n"; if($ok eq 'abcd') {print "ok 1\n"} else { warn "1: \$ok: $ok\n"; print "not ok 1\n"; } } else { eval{Rmpfr_grandom($rop1, $rop2, $state1, GMP_RNDN);}; if($@ =~ /Rmpfr_grandom not implemented/) {print "ok 1\n"} else { warn "\$\@: $@"; print "not ok 1\n"; } } Math-MPFR-3.32/t/inits.t0000644000076400010400000000152012660557734016337 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR ':mpfr'; print "1..5\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my @mpfr1 = Rmpfr_inits(17); if(scalar(@mpfr1) == 17) {print "ok 1\n"} else {print "not ok 1 ", scalar(@mpfr1), "\n"} my $ok = 1; for(@mpfr1) {$ok = 0 if !Rmpfr_nan_p($_) } if($ok) {print "ok 2\n"} else {print "not ok 2 $ok\n"} my @mpfr2 = Rmpfr_inits2(101, 17); if(scalar(@mpfr1) == 17) {print "ok 3\n"} else {print "not ok 3 ", scalar(@mpfr1), "\n"} $ok = 1; for(@mpfr2) {$ok = 0 if !Rmpfr_nan_p($_) } if($ok) {print "ok 4\n"} else {print "not ok 4 $ok\n"} $ok = 1; for(@mpfr2) {$ok = 0 if Rmpfr_get_prec($_) != 101 } if($ok) {print "ok 5\n"} else {print "not ok 5 $ok\n"} Math-MPFR-3.32/t/integer_string.t0000644000076400010400000000261712660557734020244 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..1\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $ok = ''; my $nan = Math::MPFR->new(); $ok .= 'a' if lc(Rmpfr_integer_string($nan, 10, GMP_RNDN)) eq '@nan@'; my ($man, $exp) = Rmpfr_deref2($nan, 10, 0, GMP_RNDN); $ok .= 'b' if lc($man) eq '@nan@'; my $one = Math::MPFR->new(1); my $minus_one = Math::MPFR->new(-1); my $zero = Math::MPFR->new(0); my $minus_zero = Math::MPFR->new(-0.0); my $inf = $one / $zero; $ok .= 'c' if lc(Rmpfr_integer_string($inf, 10, GMP_RNDN)) eq '@inf@'; $inf = $minus_one / $minus_zero; $ok .= 'd' if lc(Rmpfr_integer_string($inf, 10, GMP_RNDN)) eq '@inf@'; $inf = $one / $minus_zero; $ok .= 'e' if lc(Rmpfr_integer_string($inf, 10, GMP_RNDN)) eq '-@inf@'; $inf = $minus_one / $zero; $ok .= 'f' if lc(Rmpfr_integer_string($inf, 10, GMP_RNDN)) eq '-@inf@'; $ok .= 'g' if Rmpfr_integer_string($zero, 10, GMP_RNDN) eq '0'; $ok .= 'h' if Rmpfr_integer_string($minus_zero, 10, GMP_RNDN) eq '-0'; my $minus_zero2 = Math::MPFR->new(-0); $ok .= 'i' if Rmpfr_integer_string($minus_zero2, 10, GMP_RNDN) eq '0'; $ok .= 'j' if lc(Rmpfr_integer_string($zero / $minus_zero, 10, GMP_RNDN)) eq '@nan@'; if($ok eq 'abcdefghij') {print "ok 1\n"} else {print "not ok 1 $ok\n"} Math-MPFR-3.32/t/lngamma_bug.t0000644000076400010400000000211512660557734017463 0ustar sisyphusAdministrators# This file so named because it tests the fixing of a bug that had lngamma(-0) evaluate to # NaN (instead of the correct value of +Inf). # The bug was present in mpfr up to (and including) version 3.1.2. use warnings; use strict; use Math::MPFR qw(:mpfr); print "1..4\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $z = Math::MPFR->new(0); my $neg = Math::MPFR->new(-3); my $lng = Math::MPFR->new(); $z *= -1; if(Rmpfr_signbit($z)) {print "ok 1\n"} else { warn "\$z: $z\n"; print "not ok 1\n"; } Rmpfr_lngamma($lng, $z, MPFR_RNDN); if(Rmpfr_inf_p($lng) && $lng > 0) {print "ok 2\n"} else { warn "\$lng: $lng\n"; print "not ok 2\n"; } Rmpfr_lngamma($lng, $neg, MPFR_RNDN); if(Rmpfr_inf_p($lng) && $lng > 0) {print "ok 3\n"} else { warn "\$lng: $lng\n"; print "not ok 3\n"; } Rmpfr_lgamma($lng, $neg, MPFR_RNDN); if(Rmpfr_inf_p($lng) && $lng > 0) {print "ok 4\n"} else { warn "\$lng: $lng\n"; print "not ok 4\n"; } Math-MPFR-3.32/t/LongDouble.t0000644000076400010400000001601612660557734017251 0ustar sisyphusAdministrators use warnings; use strict; use Math::MPFR qw(:mpfr); my $t = 11; print "1..$t\n"; eval {require Math::LongDouble;}; unless($@ || $Math::LongDouble::VERSION < 0.02) { my $mant_dig = Math::MPFR::_LDBL_MANT_DIG(); # expected to be either 64 or 106 my $ldbl_dig = Math::LongDouble::ld_get_prec(); warn "\ndefault decimal precision: $ldbl_dig\n"; my $def_prec = 6 + $mant_dig; my $ld_version = $Math::LongDouble::VERSION; Rmpfr_set_default_prec($def_prec); my($ld_1, $ld_2) = (Math::LongDouble->new('1.123'), Math::LongDouble->new()); my $fr_plus6 = Math::MPFR->new(); my $fr_true = Rmpfr_init2($mant_dig); my ($man, $exp); Rmpfr_set_LD($fr_plus6, $ld_1, MPFR_RNDN); Rmpfr_get_LD($ld_2, $fr_plus6, MPFR_RNDN); if($ld_1 && $ld_1 == $ld_2) {print "ok 1\n"} else { warn "\$ld_1: $ld_1\n\$ld_2: $ld_2\n"; print "not ok 1\n"; } # The following binary strings represent the mantissa for 1e-37 (for varous precisions) # Precision = 112 or 70: my $str_plus6 = $mant_dig == 106 ? '1000100000011100111010100001010001010100010111000111010101110101011111100101000011010110010000010111011111011010' : '1000100000011100111010100001010001010100010111000111010101110101100000'; # Precision = 106 or 64 (but derived from the relevant above representation). my $m_plus6_to_actual = $mant_dig == 106 ? '1000100000011100111010100001010001010100010111000111010101110101011111100101000011010110010000010111011111' : '1000100000011100111010100001010001010100010111000111010101110110'; # Precision = 106 or 64 (actual correct 106/64-bit representation). my $m_actual = $mant_dig == 106 ? '1000100000011100111010100001010001010100010111000111010101110101011111100101000011010110010000010111011111' : '1000100000011100111010100001010001010100010111000111010101110101'; my $ld_check = Math::LongDouble->new('1e-37'); Rmpfr_set_str($fr_plus6, '1@-37', 10, MPFR_RNDN); Rmpfr_set_str($fr_true, '1@-37', 10, MPFR_RNDN); ($man, $exp) = Rmpfr_deref2($fr_true, 2, $mant_dig, MPFR_RNDN); print "\$man:\n$man\n\n"; ##################################################### # $ld_2, derived from $fr_true should == $ld_check # ##################################################### Rmpfr_get_LD($ld_2, $fr_true, MPFR_RNDN); $man = get_man($ld_2); my $expected; if ($ld_version < '0.16') { $expected = '1.' . ('0' x ($ldbl_dig - 1)) } elsif ($ldbl_dig == 17) { $expected = '1.0000000000000001' } elsif ($ldbl_dig == 21) { $expected = '9.99999999999999999950' } elsif ($ldbl_dig == 33) { $expected = '9.99999999999999999999999999999991' } elsif ($ldbl_dig == 36) { $expected = '9.99999999999999999999999999999999934' } else { $expected = '1.' . ('0' x ($ldbl_dig - 1)) } if($man eq $expected) {print "ok 2\n"} else { warn "\nexpected $expected, got $man\n"; print "not ok 2\n"; } if($ld_check == $ld_2) {print "ok 3\n"} else { warn "\n\$ld_check: $ld_check\n\$ld_2: $ld_2\n"; print "not ok 3\n"; } $man = get_manp($ld_2, $ldbl_dig + 1); if ($ld_version < '0.16') { $expected = '9.' . ('9' x ($ldbl_dig)) } elsif ($ldbl_dig == 17) { $expected = '1.00000000000000007' } elsif ($ldbl_dig == 21) { $expected = '9.999999999999999999497' } elsif ($ldbl_dig == 33) { $expected = '9.999999999999999999999999999999905' } elsif ($ldbl_dig == 36) { $expected = '9.999999999999999999999999999999999344' } else { $expected = '9.' . ('9' x ($ldbl_dig)) } if($man eq $expected) {print "ok 4\n"} else { warn "\nexpected $expected, got $man\n"; print "not ok 4\n"; } ##################################################### # $ld_2, derived from $fr_plus6 should != $ld_check # ##################################################### Rmpfr_get_LD($ld_2, $fr_plus6, MPFR_RNDN); $man = get_man($ld_2); if ($ld_version < '0.16') { $expected = '1.' . ('0' x ($ldbl_dig - 1)) } elsif ($ldbl_dig == 17) { $expected = '1.' . ('0' x 16) } elsif ($ldbl_dig == 21) { $expected = '1.00000000000000000005' } elsif ($ldbl_dig == 33) { $expected = '1.00000000000000000000000000000001' } elsif ($ldbl_dig == 36) { $expected = '9.99999999999999999999999999999999934' } else { $expected = '1.' . ('0' x ($ldbl_dig - 1)) } if($man eq $expected) {print "ok 5\n"} else { warn "\nexpected $expected, got $man\n"; print "not ok 5\n"; } if($ld_check != $ld_2) {print "ok 6\n"} else { warn "\n\$ld_check: $ld_check\n\$ld_2: $ld_2\n"; print "not ok 6\n"; } $man = get_manp($ld_2, 19); if($man eq '1.000000000000000000') {print "ok 7\n"} else { warn "\n\$man: $man\n"; print "not ok 7\n"; } ################################################################################## # Mantissa of $fr_plus6, rounded to $mant_dig bits should eq $m_plus6_to_actual # ################################################################################## ($man, $exp) = Rmpfr_deref2($fr_plus6, 2, $mant_dig, MPFR_RNDN); if($man eq $m_plus6_to_actual) {print "ok 8\n"} else { warn "\n\$man: $man\n $m_plus6_to_actual\n"; print "not ok 8\n"; } #################################################################### # $mant_dig-bit mantissa of $fr_true should eq $m_actual # #################################################################### ($man, $exp) = Rmpfr_deref2($fr_true, 2, $mant_dig, MPFR_RNDN); if($man eq $m_actual) {print "ok 9\n"} else { warn "\n\$man: $man\n\$m_actual: $m_actual\n"; print "not ok 9\n"; } Rmpfr_set_str($fr_plus6, $str_plus6, 2, MPFR_RNDN); ################################################################################## # Mantissa of $fr_plus6, rounded to $mant_dig bits should eq $m_plus6_to_actual # ################################################################################## ($man, $exp) = Rmpfr_deref2($fr_plus6, 2, $mant_dig, MPFR_RNDN); if($man eq $m_plus6_to_actual) {print "ok 10\n"} else { warn "\n\$man: $man\n $m_plus6_to_actual\n"; print "not ok 10\n"; } Rmpfr_set_str($fr_true, $str_plus6, 2, MPFR_RNDN); ################################################################################# # Mantissa of $fr_true, rounded to $mant_dig bits should eq $m_plus6_to_actual # ################################################################################# ($man, $exp) = Rmpfr_deref2($fr_true, 2, $mant_dig, MPFR_RNDN); if($man eq $m_plus6_to_actual) {print "ok 11\n"} else { warn "\n\$man: $man\n $m_plus6_to_actual\n"; print "not ok 11\n"; } } else { warn "\nSkipping all tests - couldn't load Math-LongDouble-0.02 (or later)\n"; for(1 .. $t) {print "ok $_\n"} } sub get_man { return (split /e/i, Math::LongDouble::LDtoSTR($_[0]))[0]; } sub get_manp { return (split /e/i, Math::LongDouble::LDtoSTRP($_[0], $_[1]))[0]; } Math-MPFR-3.32/t/MPFR_RND.t0000644000076400010400000000743312660557734016471 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..16\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; if(GMP_RNDN == MPFR_RNDN) {print "ok 1\n"} else { warn "GMP_RNDN: ", GMP_RNDN, " MPFR_RNDN: ", MPFR_RNDN, "\n"; print "not ok 1\n"; } if(GMP_RNDZ == MPFR_RNDZ) {print "ok 2\n"} else { warn "GMP_RNDZ: ", GMP_RNDZ, " MPFR_RNDZ: ", MPFR_RNDZ, "\n"; print "not ok 2\n"; } if(GMP_RNDU == MPFR_RNDU) {print "ok 3\n"} else { warn "GMP_RNDU: ", GMP_RNDU, " MPFR_RNDU: ", MPFR_RNDU, "\n"; print "not ok 3\n"; } if(GMP_RNDD == MPFR_RNDD) {print "ok 4\n"} else { warn "GMP_RNDD: ", GMP_RNDD, " MPFR_RNDD: ", MPFR_RNDD, "\n"; print "not ok 4\n"; } if(MPFR_RNDA == 4) {print "ok 5\n"} else { warn "MPFR_RNDA: ", MPFR_RNDA, "\n"; print "not ok 5\n"; } if(MPFR_VERSION_MAJOR >= 3) { my ($mpfr, $dis) = Rmpfr_init_set_ui(12345, MPFR_RNDA); if($mpfr == 12345) {print "ok 6\n"} else { warn "\$mpfr: $mpfr\n"; print "not ok 6\n"; } } else { eval {my ($mpfr, $dis) = Rmpfr_init_set_ui(12345, MPFR_RNDA);}; if($@ =~ /Illegal rounding value supplied/) {print "ok 6\n"} else { warn "\$\@: $@\n"; print "not ok 6\n"; } } if(Rmpfr_print_rnd_mode(MPFR_RNDD) eq 'MPFR_RNDD' || Rmpfr_print_rnd_mode(MPFR_RNDD) eq 'GMP_RNDD') {print "ok 7\n"} else { warn "\nExpected 'MPFR_RNDD' or 'GMP_RNDD'\nGot '", Rmpfr_print_rnd_mode(MPFR_RNDD), "'\n"; print "not ok 7\n"; } if(Rmpfr_print_rnd_mode(MPFR_RNDU) eq 'MPFR_RNDU' || Rmpfr_print_rnd_mode(MPFR_RNDU) eq 'GMP_RNDU') {print "ok 8\n"} else { warn "\nExpected 'MPFR_RNDU' or 'GMP_RNDU'\nGot '", Rmpfr_print_rnd_mode(MPFR_RNDU), "'\n"; print "not ok 8\n"; } if(Rmpfr_print_rnd_mode(MPFR_RNDN) eq 'MPFR_RNDN' || Rmpfr_print_rnd_mode(MPFR_RNDN) eq 'GMP_RNDN') {print "ok 9\n"} else { warn "\nExpected 'MPFR_RNDN' or 'GMP_RNDN'\nGot '", Rmpfr_print_rnd_mode(MPFR_RNDN), "'\n"; print "not ok 9\n"; } if(Rmpfr_print_rnd_mode(MPFR_RNDZ) eq 'MPFR_RNDZ' || Rmpfr_print_rnd_mode(MPFR_RNDZ) eq 'GMP_RNDZ') {print "ok 10\n"} else { warn "\nExpected 'MPFR_RNDZ' or 'GMP_RNDZ'\nGot '", Rmpfr_print_rnd_mode(MPFR_RNDZ), "'\n"; print "not ok 10\n"; } if(!defined(Rmpfr_print_rnd_mode(100))) {print "ok 11\n"} else { warn "\nExpected 'undef'\nGot '", Rmpfr_print_rnd_mode(100), "'\n"; print "not ok 11\n"; } if(Rmpfr_print_rnd_mode(GMP_RNDD) eq 'MPFR_RNDD' || Rmpfr_print_rnd_mode(GMP_RNDD) eq 'GMP_RNDD') {print "ok 12\n"} else { warn "\nExpected 'MPFR_RNDD' or 'GMP_RNDD'\nGot '", Rmpfr_print_rnd_mode(GMP_RNDD), "'\n"; print "not ok 12\n"; } if(Rmpfr_print_rnd_mode(GMP_RNDU) eq 'MPFR_RNDU' || Rmpfr_print_rnd_mode(GMP_RNDU) eq 'GMP_RNDU') {print "ok 13\n"} else { warn "\nExpected 'MPFR_RNDU' or 'GMP_RNDU'\nGot '", Rmpfr_print_rnd_mode(GMP_RNDU), "'\n"; print "not ok 13\n"; } if(Rmpfr_print_rnd_mode(GMP_RNDN) eq 'MPFR_RNDN' || Rmpfr_print_rnd_mode(GMP_RNDN) eq 'GMP_RNDN') {print "ok 14\n"} else { warn "\nExpected 'MPFR_RNDN' or 'GMP_RNDN'\nGot '", Rmpfr_print_rnd_mode(GMP_RNDN), "'\n"; print "not ok 14\n"; } if(Rmpfr_print_rnd_mode(GMP_RNDZ) eq 'MPFR_RNDZ' || Rmpfr_print_rnd_mode(GMP_RNDZ) eq 'GMP_RNDZ') {print "ok 15\n"} else { warn "\nExpected 'MPFR_RNDZ' or 'GMP_RNDZ'\nGot '", Rmpfr_print_rnd_mode(GMP_RNDZ), "'\n"; print "not ok 15\n"; } if(3 <= MPFR_VERSION_MAJOR) { if(Rmpfr_print_rnd_mode(MPFR_RNDA) eq 'MPFR_RNDA') {print "ok 16\n"} else { warn "\nExpected 'MPFR_RNDA'\nGot '", Rmpfr_print_rnd_mode(MPFR_RNDA), "'\n"; print "not ok 16\n"; } } else { if(!defined(Rmpfr_print_rnd_mode(MPFR_RNDA))) {print "ok 16\n"} else { warn "\nExpected 'undef'\nGot '", Rmpfr_print_rnd_mode(MPFR_RNDA), "'\n"; print "not ok 16\n"; } } Math-MPFR-3.32/t/nan_cmp.t0000644000076400010400000001320012660557734016622 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); #use Devel::Peek; print "1..7\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $nan = Math::MPFR->new(); my $pnan = Rmpfr_get_d($nan, GMP_RNDN); my $zero = Math::MPFR->new(0); my $one = Math::MPFR->new(1); my $negtwo = -$one; $negtwo --; my $postwo = $one + 1; my $posinf = $one / $zero; my $neginf = -$posinf; my $temp = Math::MPFR->new(); Rmpfr_clear_erangeflag(); my $ok = ''; if($nan == $zero || $nan == 0 || $zero / $zero == 0) {$ok .= 'A'} if(Rmpfr_erangeflag_p()) {$ok .= '&'} Rmpfr_clear_erangeflag(); if($nan < $zero || $nan < 0 || $zero / $zero < 0) {$ok .= 'B'} if(Rmpfr_erangeflag_p()) {$ok .= '*'} Rmpfr_clear_erangeflag(); if($nan <= $zero || $nan <= 0 || $zero / $zero <= 0) {$ok .= 'C'} if(Rmpfr_erangeflag_p()) {$ok .= '('} Rmpfr_clear_erangeflag(); if($nan > $zero || $nan > 0 || $zero / $zero > 0) {$ok .= 'D'} if(Rmpfr_erangeflag_p()) {$ok .= ')'} Rmpfr_clear_erangeflag(); if($nan >= $zero || $nan >= 0 || $zero / $zero >= 0) {$ok .= 'E'} if(Rmpfr_erangeflag_p()) {$ok .= '_'} Rmpfr_clear_erangeflag(); $ok .= $nan <=> $zero ? 'G' : 'a'; if(Rmpfr_erangeflag_p()) {$ok .= 'b'} Rmpfr_clear_erangeflag(); if(Rmpfr_erangeflag_p()) {$ok .= 'H'} $ok .= $nan <=> 0 ? 'I' : 'c'; if(Rmpfr_erangeflag_p()) {$ok .= 'd'} Rmpfr_clear_erangeflag(); if(Rmpfr_erangeflag_p()) {$ok .= 'J'} ########################### $ok .= $nan <=> $one ? 'K' : 'e'; if(Rmpfr_erangeflag_p()) {$ok .= 'f'} Rmpfr_clear_erangeflag(); if(Rmpfr_erangeflag_p()) {$ok .= 'L'} $ok .= $nan <=> 1 ? 'M' : 'g'; if(Rmpfr_erangeflag_p()) {$ok .= 'h'} Rmpfr_clear_erangeflag(); if(Rmpfr_erangeflag_p()) {$ok .= 'N'} if($nan == $one || $nan == 1) {$ok .= 'O'} if($nan < $one || $nan < 1) {$ok .= 'P'} if($nan <= $one || $nan <= 1) {$ok .= 'Q'} if($nan < $one || $nan < 1) {$ok .= 'R'} if($nan <= $one || $nan <= 1) {$ok .= 'S'} if($nan == $nan) {$ok .= 'T'} if($nan < $nan) {$ok .= 'U'} if($nan <= $nan) {$ok .= 'V'} if($nan < $nan) {$ok .= 'W'} if($nan <= $nan) {$ok .= 'X'} $ok .= $zero / $zero <=> 1 ? 'Y' : 'i'; $ok .= Rmpfr_nan_p($zero / $zero) ? 'j' : 'Z'; Rmpfr_clear_erangeflag(); $ok .= defined($nan <=> 0) ? '`' : 'k'; $ok .= Rmpfr_erangeflag_p() ? 'l' : '~'; Rmpfr_clear_erangeflag(); if($ok eq '&*()_abcdefghijkl') {print "ok 1\n"} else { warn "1: $ok\n"; print "not ok 1\n"; } $ok = ''; if($nan != $zero) {$ok .= 'a'} if($nan != 0) {$ok .= 'b'} if($nan != $one) {$ok .= 'c'} if($nan != 1) {$ok .= 'd'} if(!$nan) {$ok .= 'e'} if($nan) {$ok .= 'A'} if(Rmpfr_erangeflag_p()) {$ok .= 'f'} if($ok eq 'abcdef') {print "ok 2\n"} else { warn "2: $ok\n"; print "not ok 2\n"; } my $nan2 = Math::MPFR->new('nan'); if(Rmpfr_nan_p($nan2)) {print "ok 3\n"} else {print "not ok 3 $nan2\n"} if((1 ** $nan) == 1) {print "ok 4\n"} else {print "not ok 4 ", 1 ** $nan, "\n"} if(Rmpfr_nan_p(2 ** $nan)) {print "ok 5\n"} else {print "not ok 5", 2 ** $nan, "\n"} $ok = ''; if(Rmpfr_nan_p($posinf / $posinf)) {$ok .= 'a'} else {warn "a: ", $posinf / $posinf, "\n"} if(Rmpfr_nan_p($posinf / $neginf)) {$ok .= 'b'} else {warn "b: ", $posinf / $neginf, "\n"} if(Rmpfr_nan_p($neginf / $posinf)) {$ok .= 'c'} else {warn "c: ", $neginf / $posinf, "\n"} if(Rmpfr_nan_p($neginf / $neginf)) {$ok .= 'd'} else {warn "d: ", $neginf / $neginf, "\n"} if(Rmpfr_nan_p($zero * $posinf)) {$ok .= 'e'} else {warn "e: ", $zero * $posinf, "\n"} if(Rmpfr_nan_p($zero * $neginf)) {$ok .= 'f'} else {warn "f: ", $zero * $neginf, "\n"} if(Rmpfr_nan_p($neginf + $posinf)) {$ok .= 'g'} else {warn "g: ", $neginf + $posinf, "\n"} if(Rmpfr_nan_p($neginf - $neginf)) {$ok .= 'h'} else {warn "h: ", $neginf - $neginf, "\n"} if(Rmpfr_nan_p($posinf - $posinf)) {$ok .= 'i'} else {warn "i: ", $posinf - $posinf, "\n"} if(Rmpfr_nan_p(sqrt($negtwo))) {$ok .= 'j'} else {warn "j: ", sqrt($negtwo), "\n"} if(Rmpfr_nan_p(log($negtwo))) {$ok .= 'k'} else {warn "k: ", log($negtwo), "\n"} Rmpfr_log2($temp, $negtwo, GMP_RNDN); if(Rmpfr_nan_p($temp)) {$ok .= 'l'} else {warn "l: ", $temp, "\n"} Rmpfr_log10($temp, $negtwo, GMP_RNDN); if(Rmpfr_nan_p($temp)) {$ok .= 'm'} else {warn "m: ", $temp, "\n"} Rmpfr_acos($temp, $negtwo, GMP_RNDN); if(Rmpfr_nan_p($temp)) {$ok .= 'n'} else {warn "n: ", $temp, "\n"} Rmpfr_asin($temp, $negtwo, GMP_RNDN); if(Rmpfr_nan_p($temp)) {$ok .= 'o'} else {warn "o: ", $temp, "\n"} Rmpfr_acos($temp, $postwo, GMP_RNDN); if(Rmpfr_nan_p($temp)) {$ok .= 'p'} else {warn "p: ", $temp, "\n"} Rmpfr_asin($temp, $postwo, GMP_RNDN); if(Rmpfr_nan_p($temp)) {$ok .= 'q'} else {warn "q: ", $temp, "\n"} if($nan ** 0 == 1) {$ok .= 'r'} else {warn "r: ", $nan ** 0, "\n"} if($ok eq 'abcdefghijklmnopqr') {print "ok 6\n"} else {print "not ok 6 $ok\n"} $ok = ''; Rmpfr_clear_erangeflag(); $ok .= $zero < $pnan ? 'A' : 'a'; $ok .= Rmpfr_erangeflag_p() ? 'b' : 'B'; Rmpfr_clear_erangeflag(); $ok .= $zero <= $pnan ? 'C' : 'c'; $ok .= Rmpfr_erangeflag_p() ? 'd' : 'D'; Rmpfr_clear_erangeflag(); $ok .= $zero > $pnan ? 'E' : 'e'; $ok .= Rmpfr_erangeflag_p() ? 'f' : 'F'; Rmpfr_clear_erangeflag(); $ok .= $zero >= $pnan ? 'G' : 'g'; $ok .= Rmpfr_erangeflag_p() ? 'h' : 'H'; Rmpfr_clear_erangeflag(); $ok .= $zero == $pnan ? 'I' : 'i'; $ok .= Rmpfr_erangeflag_p() ? 'j' : 'J'; Rmpfr_clear_erangeflag(); $ok .= $zero != $pnan ? 'k' : 'K'; $ok .= Rmpfr_erangeflag_p() ? 'l' : 'L'; Rmpfr_clear_erangeflag(); $ok .= defined($zero <=> $pnan) ? 'M' : 'm'; $ok .= Rmpfr_erangeflag_p() ? 'n' : 'N'; Rmpfr_clear_erangeflag(); if($ok eq 'abcdefghijklmn') {print "ok 7\n"} else { warn "7: $ok\n"; print "not ok 7\n"; } Math-MPFR-3.32/t/native_float128.t0000644000076400010400000000336612660557734020131 0ustar sisyphusAdministratorsuse strict; use warnings; use Config; use Math::MPFR qw(:mpfr); my $t = 1; if(Math::MPFR::_can_pass_float128()) { print "1..$t\n"; warn "\n Can pass _float128 between perl subs and XSubs\n"; Rmpfr_set_default_prec(113); my $frac = 3.0; # For me, both C and perl miscalculates sqrt(2.0), so we'll # sweep that one under the carpet and check using sqrt(3.0), # which seems to be calculated correctly. my $fr = Math::MPFR->new($frac); $fr **= 0.5; if($fr == sqrt($frac)) {print "ok 1\n"} else { my $check = sprintf "%a", Rmpfr_get_float128($fr, MPFR_RNDN); warn "\n Expected $check\n Got ", sprintf "%a\n", sqrt($frac); print "not ok 1\n"; } } elsif($Config{nvtype} eq '__float128') { # We can't pass __float128 types, so we'll pass the values as a long double. print "1..$t\n"; # First, work out the precision of the long double: my($frac, $prec) = (2.0, $Config{longdblkind}); if(!defined($prec)) {$prec = 0} elsif($prec == 0) {$prec = 53} elsif($prec == 1 || $prec == 2) {$prec = 113} elsif($prec == 3 || $prec == 4) {$prec = 64} elsif($prec == 5 || $prec == 6) {$prec = 2098} else {$prec = 0} if(!$prec) { warn "\n Skipping tests - couldn't determine precision of long double\n"; print "ok $_\n" for 1 .. $t; exit 0; } warn "\n Casting __float128 to $prec-bit precision long double\n"; Rmpfr_set_default_prec($prec); my $fr1 = Math::MPFR->new(sqrt($frac)); my $fr2 = Math::MPFR->new(); Rmpfr_set_ld($fr2, sqrt($frac), MPFR_RNDN); if($fr1 == $fr2) {print "ok 1\n"} else { warn "\n$fr1 != $fr2\n"; print "not ok 1\n"; } } else { print "1..1\n"; warn "\n Skipping all tests - nvtype is $Config{nvtype}\n"; print "ok 1\n"; exit 0; } Math-MPFR-3.32/t/neg_zero_bug.t0000644000076400010400000001700212660557734017660 0ustar sisyphusAdministrators# This file so named because it tests the fixing of a bug with -0 and mpfr_fits_u*_p(). # The bug was present in mpfr up to (and including) version 3.1.2. use warnings; use strict; use Math::MPFR qw(:mpfr); print "1..8\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(150); my($ok, $count) = (0, 24); my @vals = ( Math::MPFR->new(-0.99999), Math::MPFR->new(-0.50001), Math::MPFR->new(-0.5), Math::MPFR->new(-0.4999999), Math::MPFR->new(-0.000001), Math::MPFR->new(0.0), ); $vals[5] *= -1.0; my @rnds = (0 .. 3); unless(3 > MPFR_VERSION_MAJOR) { $count += 6; push @rnds, 4; } for my $r(@rnds) { for my $v(@vals) { if($r == MPFR_RNDN) { if($v >= -0.5) { if(Rmpfr_fits_ushort_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"} } else { if(!Rmpfr_fits_ushort_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"} } } elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) { if(Rmpfr_fits_ushort_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"} } else { if($v == 0) { if(Rmpfr_fits_ushort_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"} } else { if(!Rmpfr_fits_ushort_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"} } } } } if($ok == $count) {print "ok 1\n"} else { warn "\n\$ok: $ok\n\$count: $count\n"; print "not ok 1\n"; } $ok = 0; for my $r(@rnds) { for my $v(@vals) { if($r == MPFR_RNDN) { if($v >= -0.5) { if(Rmpfr_fits_uint_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"} } else { if(!Rmpfr_fits_uint_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"} } } elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) { if(Rmpfr_fits_uint_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"} } else { if($v == 0) { if(Rmpfr_fits_uint_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"} } else { if(!Rmpfr_fits_uint_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"} } } } } if($ok == $count) {print "ok 2\n"} else { warn "\n\$ok: $ok\n\$count: $count\n"; print "not ok 2\n"; } $ok = 0; for my $r(@rnds) { for my $v(@vals) { if($r == MPFR_RNDN) { if($v >= -0.5) { if(Rmpfr_fits_ulong_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"} } else { if(!Rmpfr_fits_ulong_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"} } } elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) { if(Rmpfr_fits_ulong_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"} } else { if($v == 0) { if(Rmpfr_fits_ulong_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"} } else { if(!Rmpfr_fits_ulong_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"} } } } } if($ok == $count) {print "ok 3\n"} else { warn "\n\$ok: $ok\n\$count: $count\n"; print "not ok 3\n"; } $ok = 0; for my $r(@rnds) { for my $v(@vals) { if($r == MPFR_RNDN) { if($v >= -0.5) { if(Rmpfr_fits_uintmax_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"} } else { if(!Rmpfr_fits_uintmax_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"} } } elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) { if(Rmpfr_fits_uintmax_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"} } else { if($v == 0) { if(Rmpfr_fits_uintmax_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"} } else { if(!Rmpfr_fits_uintmax_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"} } } } } if($ok == $count) {print "ok 4\n"} else { warn "\n\$ok: $ok\n\$count: $count\n"; print "not ok 4\n"; } $ok = 0; for my $r(@rnds) { for my $v(@vals) { if($r == MPFR_RNDN) { if($v >= -0.5) { if(Rmpfr_fits_UV_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"} } else { if(!Rmpfr_fits_UV_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"} } } elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) { if(Rmpfr_fits_UV_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"} } else { if($v == 0) { if(Rmpfr_fits_UV_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"} } else { if(!Rmpfr_fits_UV_p($v, $r)) {$ok++} else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"} } } } } if($ok == $count) {print "ok 5\n"} else { warn "\n\$ok: $ok\n\$count: $count\n"; print "not ok 5\n"; } $ok = 0; for my $r(@rnds) { for my $v(@vals) { if(Rmpfr_fits_sshort_p($v, $r)) {$ok++} else { warn "sshort: $r : $v : ", Rmpfr_fits_sshort_p($v, $r), "\n"} if(Rmpfr_fits_sint_p($v, $r)) {$ok++} else { warn "sint: $r : $v : ", Rmpfr_fits_sint_p($v, $r), "\n"} if(Rmpfr_fits_slong_p($v, $r)) {$ok++} else { warn "slong: $r : $v : ", Rmpfr_fits_slong_p($v, $r), "\n"} if(Rmpfr_fits_intmax_p($v, $r)) {$ok++} else { warn "intmax: $r : $v : ", Rmpfr_fits_intmax_p($v, $r), "\n"} if(Rmpfr_fits_IV_p($v, $r)) {$ok++} else { warn "IV: $r : $v : ", Rmpfr_fits_IV_p($v, $r), "\n"} } } if($ok == $count * 5) {print "ok 6\n"} else { warn "\n\$ok: $ok\n\$count: $count\n"; print "not ok 6\n"; } my $fr1 = Math::MPFR->new(-1.0); my $fr2 = Math::MPFR->new(0.6); $ok = 1; for my $r(@rnds) { if(Rmpfr_fits_ushort_p($fr1, $r)) { warn "ushort: $fr1: $r: ", Rmpfr_fits_ushort_p($fr1, $r), "\n"; $ok = 0; } if(Rmpfr_fits_uint_p($fr1, $r)) { warn "uint: $fr1: $r: ", Rmpfr_fits_uint_p($fr1, $r), "\n"; $ok = 0; } if(Rmpfr_fits_ulong_p($fr1, $r)) { warn "ulong: $fr1: $r: ", Rmpfr_fits_ulong_p($fr1, $r), "\n"; $ok = 0; } if(Rmpfr_fits_uintmax_p($fr1, $r)) { warn "uintmax: $fr1: $r: ", Rmpfr_fits_uintmax_p($fr1, $r), "\n"; $ok = 0; } if(Rmpfr_fits_UV_p($fr1, $r)) { warn "UV: $fr1: $r: ", Rmpfr_fits_UV_p($fr1, $r), "\n"; $ok = 0; } } if($ok){print "ok 7\n"} else {print "not ok 7\n"} $ok = 1; for my $r(@rnds) { if(!Rmpfr_fits_ushort_p($fr2, $r)) { warn "ushort: $fr2: $r: ", Rmpfr_fits_ushort_p($fr2, $r), "\n"; $ok = 0; } if(!Rmpfr_fits_uint_p($fr2, $r)) { warn "uint: $fr2: $r: ", Rmpfr_fits_uint_p($fr2, $r), "\n"; $ok = 0; } if(!Rmpfr_fits_ulong_p($fr2, $r)) { warn "ulong: $fr2: $r: ", Rmpfr_fits_ulong_p($fr2, $r), "\n"; $ok = 0; } if(!Rmpfr_fits_uintmax_p($fr2, $r)) { warn "uintmax: $fr2: $r: ", Rmpfr_fits_uintmax_p($fr2, $r), "\n"; $ok = 0; } if(!Rmpfr_fits_UV_p($fr2, $r)) { warn "UV: $fr2: $r: ", Rmpfr_fits_UV_p($fr2, $r), "\n"; $ok = 0; } } if($ok){print "ok 8\n"} else {print "not ok 8\n"} Math-MPFR-3.32/t/new.t0000644000076400010400000001274612660557734016016 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); use Math::BigInt; use Config; print "1..9\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $ui = 123569; my $si = -19907; my $d = -1.625; my $str = '-119.125'; my $ok = ''; my $f00 = new Math::MPFR(); if(Rmpfr_nan_p($f00)) {$ok = 'a'} Rmpfr_set_ui($f00, $ui, Rmpfr_get_default_rounding_mode()); if($f00 == $ui) {$ok .= 'b'} my $f01 = new Math::MPFR($ui); if($f01 == $ui) {$ok .= 'c'} my $f02 = new Math::MPFR($si); if($f02 == $si) {$ok .= 'd'} my $f03 = new Math::MPFR($d); if($f03 == $d) {$ok .= 'e'} my $f04 = new Math::MPFR($str); if($f04 == $str) {$ok .= 'f'} my $f05 = new Math::MPFR($str, 10); if($f05 == $str) {$ok .= 'g'} my $f06 = new Math::MPFR($d); if($f06 == $d) {$ok .= 'h'} if($ok eq 'abcdefgh') {print "ok 1\n"} else { warn "\$ok: $ok\n"; print "not ok 1\n"; } ############################# $ok = ''; my $f10 = Math::MPFR::new(); if(Rmpfr_nan_p($f10)) {$ok = 'a'} Rmpfr_set_ui($f10, $ui, Rmpfr_get_default_rounding_mode()); if($f10 == $ui) {$ok .= 'b'} my $f11 = Math::MPFR::new($ui); if($f11 == $ui) {$ok .= 'c'} my $f12 = Math::MPFR::new($si); if($f12 == $si) {$ok .= 'd'} my $f13 = Math::MPFR::new($d); if($f13 == $d) {$ok .= 'e'} my $f14 = Math::MPFR::new($str); if($f14 == $str) {$ok .= 'f'} my $f15 = Math::MPFR::new($str, 10); if($f15 == $str) {$ok .= 'g'} my $f16 = Math::MPFR::new($d); if($f16 == $d) {$ok .= 'h'} if($ok eq 'abcdefgh') {print "ok 2\n"} else { warn "\$ok: $ok\n"; print "not ok 2\n"; } ################################ $ok = ''; my $f20 = Math::MPFR->new(); if(Rmpfr_nan_p($f20)) {$ok = 'a'} else {warn "3a: $f20\n"} Rmpfr_set_ui($f20, $ui, Rmpfr_get_default_rounding_mode()); if($f20 == $ui) {$ok .= 'b'} else {warn "3b: $f20\n"} my $f21 = Math::MPFR->new($ui); if($f21 == $ui) {$ok .= 'c'} else {warn "3c: $f21\n"} my $f22 = Math::MPFR->new($si); if($f22 == $si) {$ok .= 'd'} else {warn "3d: $f22\n"} my $f23 = Math::MPFR->new($d); if($f23 == $d) {$ok .= 'e'} else {warn "3e: $f23\n"} my $f24 = Math::MPFR->new($str); if($f24 == $str) {$ok .= 'f'} else {warn "3f: $f24\n"} my $f25 = Math::MPFR->new($str, 10); if($f25 == $str) {$ok .= 'g'} else {warn "3g: $f25\n"} my $f26 = Math::MPFR->new($d); if($f26 == $d) {$ok .= 'h'} else {warn "3h: $f26\n"} Rmpfr_set_default_prec(100); my $f27 = Math::MPFR->new(36028797018964023); my $f28 = Math::MPFR->new('36028797018964023'); if(Math::MPFR::_has_longlong() || $Config{ivsize} >= 8) { if($f27 == $f28) {$ok .= 'i'} else {warn "== : $f27 $f28\n"} } else { if(Math::MPFR::_has_longdouble()) { if($f27 == $f28) {$ok .= 'i'} else {warn "== : $f27 $f28\n"} } else { if($f27 != $f28) {$ok .= 'i'} else {warn "!= : $f27 $f28\n"} } } if($ok eq 'abcdefghi') {print "ok 3\n"} else { warn "\$ok: $ok\n"; print "not ok 3\n"; } ############################# my $bi = Math::BigInt->new(123456789); $ok = ''; eval{my $f30 = Math::MPFR->new(17, 12);}; if($@ =~ /Too many arguments supplied to new\(\) \- expected only one/) {$ok = 'a'} eval{my $f31 = Math::MPFR::new(17, 12);}; if($@ =~ /Too many arguments supplied to new\(\) \- expected only one/) {$ok .= 'b'} eval{my $f32 = Math::MPFR->new($str, 12, 7);}; if($@ =~ /Too many arguments supplied to new\(\)/) {$ok .= 'c'} eval{my $f33 = Math::MPFR::new($str, 12, 7);}; if($@ =~ /Too many arguments supplied to new\(\) \- expected no more than two/) {$ok .= 'd'} eval{my $f34 = Math::MPFR->new($bi);}; if($@ =~ /Inappropriate argument/) {$ok .= 'e'} eval{my $f35 = Math::MPFR::new($bi);}; if($@ =~ /Inappropriate argument/) {$ok .= 'f'} eval{my $f36 = Math::MPFR->new("17", 42);}; if($@ =~ /Invalid value for base/) {$ok .= 'g'} if($ok eq 'abcdefg') {print "ok 4\n"} else { warn "\$ok: $ok\n"; print "not ok 4\n"; } ############################### $ok = ''; my($gmpf, $gmpq, $gmpz, $gmp) = (0, 0, 0, 0); eval{require Math::GMPf;}; if(!$@) {$gmpf = 1} eval{require Math::GMPq;}; if(!$@) {$gmpq = 1} eval{require Math::GMPz;}; if(!$@) {$gmpz = 1} eval{require Math::GMP;}; if(!$@) {$gmp = 1} if($gmpf) { my $x = Math::GMPf::new(125.5); my $y = Math::MPFR::new($x); my $z = Math::MPFR->new($x); if($y == $z && $z == 125.5) {print "ok 5\n"} else { warn "\$y: $y\n\$z: $z\n"; print "not ok 5\n"; } } else { warn "Skipping test 5 - no Math::GMPf\n"; print "ok 5\n"; } if($gmpq) { my $x = Math::GMPq::new('251/2'); my $y = Math::MPFR::new($x); my $z = Math::MPFR->new($x); if($y == $z && $z == 125.5) {print "ok 6\n"} else { warn "\$y: $y\n\$z: $z\n"; print "not ok 6\n"; } } else { warn "Skipping test 6 - no Math::GMPq\n"; print "ok 6\n"; } if($gmpz) { my $x = Math::GMPz::new(125.5); my $y = Math::MPFR::new($x); my $z = Math::MPFR->new($x); if($y == $z && $z == 125) {print "ok 7\n"} else { warn "\$y: $y\n\$z: $z\n"; print "not ok 7\n"; } } else { warn "Skipping test 7 - no Math::GMPz\n"; print "ok 7\n"; } if($gmp) { my $x = Math::GMP->new(125); my $y = Math::MPFR::new($x); my $z = Math::MPFR->new($x); if($y == $z && $z == 125) {print "ok 8\n"} else { warn "\$y: $y\n\$z: $z\n"; print "not ok 8\n"; } } else { warn "Skipping test 8 - no Math::GMP\n"; print "ok 8\n"; } my $x = Math::MPFR::new(12345.5); my $y = Math::MPFR::new($x); my $z = Math::MPFR->new($x); if($y == $z && $z == 12345.5) {print "ok 9\n"} else { warn "\$y: $y\n\$z: $z\n"; print "not ok 9\n"; } Math-MPFR-3.32/t/not_zero.t0000644000076400010400000000776512660557734017071 0ustar sisyphusAdministrators# Just some additional tests to check that ~0, unsigned and signed longs are # are being handled as expected. use warnings; use strict; use Math::MPFR qw(:mpfr); use Config; print"1..6\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(65); my $n = ~0; my $mpfr1 = Math::MPFR::new($n); my $mpfr2 = Math::MPFR->new($n); my ($mpfr3, $info3) = Rmpfr_init_set_ui($n, GMP_RNDN); my ($mpfr4, $info4) = Rmpfr_init_set_si($n, GMP_RNDN); if($mpfr4 == -1) {print "ok 1\n"} else {print "not ok 1\n"} if($mpfr1 == $n && $mpfr2 == $n ) {print "ok 2\n"} else {print "not ok 2\n"} if(Math::MPFR::_has_longlong() && $Config::Config{longsize} == 4) { if($mpfr3 != $n) {print "ok 3 A\n"} else {print "not ok 3 A $mpfr3 == $n\n"} } else { if($n == $mpfr3) {print "ok 3 B \n"} else {print "not ok 3 B $mpfr3 != $n\n"} } my $ok = ''; # Check the overloaded operators. # But skip these tests 4a to 4h (as they fail) if # $] < 5.007 and perl was built with -Duse64bitint # but without -Duselongdouble if(!($] < 5.007 && !Math::MPFR::_has_longdouble() && Math::MPFR::_has_longlong())) { if($mpfr1 - 1 == $n - 1) {$ok .= 'a'} else {warn "4a: ", $mpfr1 - 1, " != ", $n - 1} $mpfr1 -= 1; if($mpfr1 == $n - 1) {$ok .= 'b'} else {warn "4b: ", $mpfr1, " != ", $n - 1} $mpfr1 = $mpfr1 / 2; if($mpfr1 == ($n - 1) / 2) {$ok .= 'c'} else { my $t = ($n - 1) / 2; warn "4c: ", $mpfr1, " != ", $t; } $mpfr1 = $mpfr1 * 2; if($mpfr1 == $n - 1) {$ok .= 'd'} else {warn "4d: ", $mpfr1, " != ", $n - 1} $mpfr1 /= 2; if($mpfr1 == ($n - 1) / 2) {$ok .= 'e'} else { my $t = ($n - 1) / 2; warn "4e: ", $mpfr1 - 1, " != ", $t; } $mpfr1 *= 2; if($mpfr1 == $n - 1) {$ok .= 'f'} else {warn "4f: ", $mpfr1, " != ", $n - 1} if($mpfr1 + 1 == $n) {$ok .= 'g'} else {warn "4g: ", $mpfr1 + 1, " != ", $n} $mpfr1 += 1; if($mpfr1 == $n) {$ok .= 'h'} else {warn "4h: ", $mpfr1, " != ", $n} } else { warn "Skipping tests 4a to 4h as they fail on perl 5.6\nbuilt with -Duse64bitint but without -Duselongdouble\n"; $ok = 'abcdefgh'; } #my $bits = Math::MPFR::_has_longlong() ? 32 : 16; my $bits = $Config{ivsize} > 4 ? 32 : 16; if($mpfr1 ** 0.5 < 2 ** $bits && $mpfr1 ** 0.5 > (2 ** $bits) - 1 ) {$ok .= 'i'} $mpfr1 **= 0.5; if($mpfr1 < 2 ** $bits && $mpfr1 > (2 ** $bits) - 1) {$ok .= 'j'} if($ok eq 'abcdefghij') {print "ok 4\n"} else {print "not ok 4 $ok\n"} if(Math::MPFR::_has_longlong()) { my $ul; if($Config::Config{cc} eq 'cl') { $ul = Rmpfr_integer_string($mpfr2, 10, GMP_RNDN); } else {$ul = Rmpfr_get_uj($mpfr2, GMP_RNDN)} if($ul == $n) {print "ok 5\n"} else {print "not ok 5 $ul != $n\n"} } else { warn "Skipping test 5 - no 'long long' support\n"; print "ok 5\n"; } $ok = ''; Rmpfr_set_str($mpfr1, ~0, 10, GMP_RNDN); my $string = Rmpfr_integer_string($mpfr1, 10, GMP_RNDN); if($string == ~0) {$ok .= 'a'} else {print "$string != ", ~0, "\n"} $mpfr1 += 0.25; $string = Rmpfr_integer_string($mpfr1, 10, GMP_RNDN); if($string == ~0) {$ok .= 'b'} else {print "$string != ", ~0, "\n"} if(Math::MPFR::_has_longdouble()) { Rmpfr_set_ld($mpfr1, (~0 - 1) / -2, GMP_RNDN); } elsif(Math::MPFR::_has_longlong()){ if(Math::MPFR::_has_inttypes()) { Rmpfr_set_sj($mpfr1, (~0 - 1) / -2, GMP_RNDN); } else {Rmpfr_set_str($mpfr1, (~0 - 1) / -2, 10, GMP_RNDN)} } elsif($Config{ivsize} >= 8) { # Not a 'long long'; must be a 'long' Rmpfr_set_si($mpfr1, (~0 - 1) / -2, GMP_RNDN); } else { Rmpfr_set_d($mpfr1, (~0 - 1) / -2, GMP_RNDN); } $string = Rmpfr_integer_string($mpfr1, 10, GMP_RNDN); if($string == (~0 - 1) / -2) {$ok .= 'c'} else {print "$string != ", (~0 - 1) / -2, "\n"} $mpfr1 -= 0.25; $string = Rmpfr_integer_string($mpfr1, 10, GMP_RNDN); if($string == (~0 - 1) / -2) {$ok .= 'd'} else {print "$string != ", (~0 - 1) / -2, "\n"} if($ok eq 'abcd') {print "ok 6\n"} else {print "not ok 6 $ok \n"} Math-MPFR-3.32/t/out_str.t0000644000076400010400000000445312660557734016720 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..3\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(100); my $str = Math::MPFR->new('3579' x 6); my $ok = ''; my $ret = Rmpfr_out_str($str, 16, 0, GMP_RNDN); if($ret == 30) {$ok .= 'a'} else {print "\nReturned: ", $ret, "\n"} print "\n"; $ret = Rmpfr_out_str($str, 16, 0, GMP_RNDN, " \n"); if($ret == 30) {$ok .= 'b'} else {print "Returned: ", $ret, "\n"} $ret = Rmpfr_out_str("hello world ", $str, 16, 0, GMP_RNDN); if($ret == 30) {$ok .= 'c'} else {print "Returned: ", $ret, "\n"} print "\n"; $ret = Rmpfr_out_str("hello world ", $str, 16, 0, GMP_RNDN, " \n"); if($ret == 30) {$ok .= 'd'} else {print "Returned: ", $ret, "\n"} if($ok eq 'abcd') {print "ok 1 \n"} else {print "not ok 1 $ok\n"} $ok = ''; eval{$ret = Rmpfr_out_str($str, 16, 0);}; $ok .= 'a' if $@ =~ /Wrong number of arguments/; eval{$ret = Rmpfr_out_str($str, 16, 0, GMP_RNDN, 7, 5, 6);}; $ok .= 'b' if $@ =~ /Wrong number of arguments/; if($ok eq 'ab') {print "ok 2 \n"} else {print "not ok 2 $ok\n"} $ok = ''; my $mpfr = Math::MPFR->new(0.1); $ok .= 'a' if Rmpfr_integer_string($mpfr, 10, GMP_RNDN) == 0; $mpfr *= -1; $ok .= 'b' if Rmpfr_integer_string($mpfr, 10, GMP_RNDN) == 0; $ok .= 'c' if Rmpfr_integer_string($mpfr, 31, GMP_RNDN) == 0; $mpfr *= -1; $ok .= 'd' if Rmpfr_integer_string($mpfr, 5, GMP_RNDN) == 0; Rmpfr_set_ui($mpfr, 1, GMP_RNDN); $ok .= 'e' if Rmpfr_integer_string($mpfr, 10, GMP_RNDN) == 1; $mpfr *= -1; $ok .= 'f' if Rmpfr_integer_string($mpfr, 10, GMP_RNDN) == -1; $ok .= 'g' if Rmpfr_integer_string($mpfr, 30, GMP_RNDN) == -1; $mpfr *= -1; $ok .= 'h' if Rmpfr_integer_string($mpfr, 6, GMP_RNDN) == 1; $mpfr += 0.001; $ok .= 'i' if Rmpfr_integer_string($mpfr, 10, GMP_RNDN) == 1; $mpfr *= -1; $ok .= 'j' if Rmpfr_integer_string($mpfr, 10, GMP_RNDN) == -1; $ok .= 'k' if Rmpfr_integer_string($mpfr, 29, GMP_RNDN) == -1; $mpfr *= -1; $ok .= 'l' if Rmpfr_integer_string($mpfr, 7, GMP_RNDN) == 1; eval {Rmpfr_integer_string($mpfr, 0, GMP_RNDN);}; if($@ =~ /Rmpfr_integer_string/) {$ok .= 'm'} else {print $@, "\n"} if($ok eq 'abcdefghijklm') {print "ok 3\n"} else {print "not ok 3 $ok\n"} Math-MPFR-3.32/t/overload.t0000644000076400010400000006213712660557734017037 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); use Math::BigInt; # for some error tests print "1..66\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(200); my $p = Rmpfr_init(); my $q = Rmpfr_init(); my $ui = (2 ** 31) + 17; my $negi = -1236; my $posi = 1238; my($posd, $negd); if(Math::MPFR::_has_longlong()) { use integer; $posd = (2 ** 41) + 11234; $negd = -((2 ** 43) - 111); } else { $posd = (2 ** 41) + 11234; $negd = -((2 ** 43) - 111); } my $frac = 23.124901; Rmpfr_set_ui($p, 1234, GMP_RNDN); Rmpfr_set_si($q, -5678, GMP_RNDN); my $ok = ''; my $z = $p * $q; if(Rmpfr_get_str($z, 10,7, GMP_RNDN) eq '-7.006652e6' && $z == -7006652 && "$z" eq '-7.006652e6') {$ok = 'a'} $z = $p * $ui; if(Rmpfr_get_str($z, 10, 13, GMP_RNDN) eq '2.649994842610e12' && $z == 2649994842610 && "$z" eq '2.64999484261e12') {$ok .= 'b'} $z = $p * $negi; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '-1.525224e6' && $z == -1525224 && "$z" eq '-1.525224e6') {$ok .= 'c'} $z = $p * $posd; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '2.713594711213924e15' && $z == 2713594711213924 && "$z" eq '2.713594711213924e15' ) {$ok .= 'd'} $z = $p * $negd; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '-1.0854378789267698e16' && $z == -10854378789267698 && "$z" eq '-1.0854378789267698e16' ) {$ok .= 'e'} $z = $p * $frac; if($z > 28536.12783 && $z < 28536.12784) {$ok .= 'f'} $z = $p * $posi; if($z == 1527692) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 1\n"} else {print "not ok 1 $ok\n"} $ok = ''; $p *= $q; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '-7.006652e6' && $p == -7006652 && "$p" eq '-7.006652e6') {$ok = 'a'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p *= $ui; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '2.64999484261e12' && $p == 2649994842610 && "$p" eq '2.64999484261e12') {$ok .= 'b'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p *= $negi; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '-1.525224e6' && $p == -1525224 && "$p" eq '-1.525224e6') {$ok .= 'c'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p *= $posd; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '2.713594711213924e15' && $p == 2713594711213924 && "$p" eq '2.713594711213924e15') {$ok .= 'd'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p *= $negd; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '-1.0854378789267698e16' && $p == -10854378789267698 && "$p" eq '-1.0854378789267698e16') {$ok .= 'e'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p *= $frac; if($p > 28536.12783 && $p < 28536.12784) {$ok .= 'f'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p *= $posi; if($p == 1527692) {$ok .= 'g'} Rmpfr_set_ui($p, 1234, GMP_RNDN); if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($p) == 1) {print "ok 2\n"} else {print "not ok 2 $ok\n"} $ok = ''; $z = $p + $p; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '2.468e3' && $z == 2468 && "$z" eq '2.468e3') {$ok = 'a'} $z = $p + $ui; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '2.147484899e9' && $z == 2147484899 && "$z" eq '2.147484899e9') {$ok .= 'b'} $z = $p + $negi; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '-2' && $z == -2 && "$z" eq '-2') {$ok .= 'c'} $z = $p + $posd; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '2.19902326802e12' && $z == 2199023268020 && "$z" eq '2.19902326802e12') {$ok .= 'd'} $z = $p + $negd; if(Rmpfr_get_str($z, 10, 0, GMP_RNDN) eq '-8.796093020863e12' && $z == -8796093020863 && "$z" eq '-8.796093020863e12') {$ok .= 'e'} $z = $p + $frac; if($z > 1257.1249 && $z < 1257.124902) {$ok .= 'f'} $z = $p + $posi; if($z == 2472) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($z) == 1) {print "ok 3\n"} else {print "not ok 3 $ok\n"} $ok = ''; $p += $p; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '2.468e3' && $p == 2468 && "$p" eq '2.468e3') {$ok = 'a'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p += $ui; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '2.147484899e9' && $p == 2147484899 && "$p" eq '2.147484899e9') {$ok .= 'b'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p += $negi; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '-2' && $p == -2 && "$p" eq '-2') {$ok .= 'c'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p += $posd; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '2.19902326802e12' && $p == 2199023268020 && "$p" eq '2.19902326802e12') {$ok .= 'd'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p += $negd; if(Rmpfr_get_str($p, 10, 0, GMP_RNDN) eq '-8.796093020863e12' && $p == -8796093020863 && "$p" eq '-8.796093020863e12') {$ok .= 'e'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p += $frac; if($p > 1257.1249 && $p < 1257.124902) {$ok .= 'f'} Rmpfr_set_ui($p, 1234, GMP_RNDN); $p += $posi; if($p == 2472) {$ok .= 'g'} Rmpfr_set_ui($p, 1234, GMP_RNDN); if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($p) == 1) {print "ok 4\n"} else {print "not ok 4 $ok\n"} $ok = ''; $z = $p / $q; if($z > -0.2174 && $z < -0.2173) {$ok = 'a'} $z *= $q / $p; if($z > 0.999 && $z < 1.001) {$ok .= '1'} $z = $p / $ui; if($z > 5.7462e-7 && $z < 5.7463e-7) {$ok .= 'b'} $z *= $ui / $p; if($z > 0.999 && $z < 1.001) {$ok .= '2'} $z = $p / $negi; if($z > -0.998382 && $z < -0.998381) {$ok .= 'c'} $z *= $negi / $p; if($z > 0.999 && $z < 1.001) {$ok .= '3'} $z = $p / $posd; if($z > 5.6115822e-10 && $z < 5.6115823e-10 ) {$ok .= 'd'} $z *= $posd / $p; if($z > 0.999 && $z < 1.001) {$ok .= '4'} $z = $p / $negd; if($z > -1.402896e-10 && $z < -1.402895e-10 ) {$ok .= 'e'} $z *= $negd / $p; if($z > 0.999 && $z < 1.001) {$ok .= '5'} $z = $p / $frac; if($z > 53.36239 && $z < 53.362391 ) {$ok .= 'f'} $z *= $frac / $p; if($z > 0.999 && $z < 1.001) {$ok .= '6'} $z = $p / $posi; if($z > 0.9967 && $z < 0.9968 ) {$ok .= 'g'} $z *= $posi / $p; if($z > 0.999 && $z < 1.001) {$ok .= '7'} if($ok eq 'a1b2c3d4e5f6g7' && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($z) == 1) {print "ok 5\n"} else {print "not ok 5 $ok\n"} $ok = ''; $p *= $ui; $p /= $ui; if($p < 1234.0001 && $p > 1233.9999) {$ok = 'a'} $p *= $negi; $p /= $negi; if($p < 1234.0001 && $p > 1233.9999) {$ok .= 'b'} $p *= $posd; $p /= $posd; if($p < 1234.0001 && $p > 1233.9999) {$ok .= 'c'} $p *= $negd; $p /= $negd; if($p < 1234.0001 && $p > 1233.9999) {$ok .= 'd'} $p *= $frac; $p /= $frac; if($p < 1234.0001 && $p > 1233.9999) {$ok .= 'e'} $p *= $q; $p /= $q; if($p < 1234.0001 && $p > 1233.9999) {$ok .= 'f'} $p *= $posi; $p /= $posi; if($p < 1234.0001 && $p > 1233.9999) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($p) == 1) {print "ok 6\n"} else {print "not ok 6 $ok\n"} my $c = $p; if("$c" eq '1.234e3' && "$c" eq "$p" && $c == $p && $c != $q && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($c) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 7\n"} else {print "not ok 7\n"} $c *= -1; if(Rmpfr_get_str(abs($c), 10, 0, GMP_RNDN) eq '1.234e3' && Math::MPFR::get_refcnt($c) == 1) {print "ok 8\n"} else {print "not ok 8\n"} $ok = adjust($p!=$ui).adjust($p==$ui).adjust($p>$ui).adjust($p>=$ui).adjust($p<$ui) .adjust($p<=$ui).adjust($p<=>$ui); if($ok eq '100011-1') {print "ok 9\n"} else {print "not ok 9\n"} $ok = adjust($p!=$negi).adjust($p==$negi).adjust($p>$negi).adjust($p>=$negi) .adjust($p<$negi).adjust($p<=$negi).adjust($p<=>$negi); if($ok eq '1011001') {print "ok 10\n"} else {print "not ok 10\n"} $ok = adjust($p!=$posd).adjust($p==$posd).adjust($p>$posd).adjust($p>=$posd) .adjust($p<$posd).adjust($p<=$posd).adjust($p<=>$posd); if($ok eq '100011-1') {print "ok 11\n"} else {print "not ok 11\n"} $ok = adjust($p!=$negd).adjust($p==$negd).adjust($p>$negd).adjust($p>=$negd) .adjust($p<$negd).adjust($p<=$negd).adjust($p<=>$negd); if($ok eq '1011001') {print "ok 12\n"} else {print "not ok 12\n"} $ok = adjust($p!=$frac).adjust($p==$frac).adjust($p>$frac).adjust($p>=$frac) .adjust($p<$frac).adjust($p<=$frac).adjust($p<=>$frac); if($ok eq '1011001') {print "ok 13\n"} else {print "not ok 13\n"} $ok = adjust($ui!=$p).adjust($ui==$p).adjust($ui>$p).adjust($ui>=$p) .adjust($ui<$p).adjust($ui<=$p).adjust($ui<=>$p); if($ok eq '1011001') {print "ok 14\n"} else {print "not ok 14\n"} $ok = adjust($negi!=$p).adjust($negi==$p).adjust($negi>$p).adjust($negi>=$p) .adjust($negi<$p).adjust($negi<=$p).adjust($negi<=>$p); if($ok eq '100011-1') {print "ok 15\n"} else {print "not ok 15\n"} $ok = adjust($posd!=$p).adjust($posd==$p).adjust($posd>$p).adjust($posd>=$p) .adjust($posd<$p).adjust($posd<=$p).adjust($posd<=>$p); if($ok eq '1011001') {print "ok 16\n"} else {print "not ok 16\n"} $ok = adjust($negd!=$p).adjust($negd==$p).adjust($negd>$p).adjust($negd>=$p) .adjust($negd<$p).adjust($negd<=$p).adjust($negd<=>$p); if($ok eq '100011-1') {print "ok 17\n"} else {print "not ok 17\n"} $ok = adjust($frac!=$p).adjust($frac==$p).adjust($frac>$p).adjust($frac>=$p) .adjust($frac<$p).adjust($frac<=$p).adjust($frac<=>$p); if($ok eq '100011-1' && Math::MPFR::get_refcnt($p) == 1) {print "ok 18\n"} else {print "not ok 18\n"} Rmpfr_set_ui($q, 0, GMP_RNDN); if($p && Math::MPFR::get_refcnt($p) == 1) {print "ok 19\n"} else {print "not ok 19 $p\n"} if(!$q && Math::MPFR::get_refcnt($q) == 1) {print "ok 20\n"} else {print "not ok 20\n"} if(not($q) && Math::MPFR::get_refcnt($q) == 1) {print "ok 21\n"} else {print "not ok 21\n"} unless($q || Math::MPFR::get_refcnt($q) != 1) {print "ok 22\n"} else {print "not ok 22\n"} $z = $c; $z *= -1; if($z == -$c && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($c) == 1) {print "ok 23\n"} else { warn "\$z: $z -\$c: ", -$c, "\n"; warn "refcounts are ", Math::MPFR::get_refcnt($z), " and ", Math::MPFR::get_refcnt($c), "\n"; print "not ok 23\n"; } $ok = ''; $z = $p - $p; $z += $p; if($z == $p) {$ok = 'a'} $z = $p - $ui; $z += $ui; if($z == $p) {$ok .= 'b'} $z = $p - $negi; $z += $negi; if($z == $p) {$ok .= 'c'} $z = $p - $negd; $z += $negd; if($z == $p) {$ok .= 'd'} $z = $p - $posd; $z += $posd; if($z == $p) {$ok .= 'e'} $z = $p - $frac; $z += $frac; if($z == $p) {$ok .= 'f'} $z = $p - $posi; $z += $posi; if($z == $p) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1) {print "ok 24\n"} else {print "not ok 24 $ok\n"} $ok = ''; $z = $p + $p; $z -= $p; if($z == $p) {$ok = 'a'} $z = $p + $ui; $z -= $ui; if($z == $p) {$ok .= 'b'} $z = $p + $negi; $z -= $negi; if($z == $p) {$ok .= 'c'} $z = $p + $negd; $z -= $negd; if($z == $p) {$ok .= 'd'} $z = $p + $posd; $z -= $posd; if($z == $p) {$ok .= 'e'} $z = $p + $frac; $z -= $frac; if($z == $p) {$ok .= 'f'} $z = $p + $posi; $z -= $posi; if($z == $p) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1) {print "ok 25\n"} else {print "not ok 25 $ok\n"} $ok = ''; $z = $p - $p; $z += $p; if($z == $p) {$ok = 'a'} $z = $ui - $p; $z -= $ui; if($z == -$p) {$ok .= 'b'} $z = $negi - $p; $z -= $negi; if($z == -$p) {$ok .= 'c'} $z = $negd - $p; $z -= $negd; if($z == -$p) {$ok .= 'd'} $z = $posd - $p; $z -= $posd; if($z == -$p) {$ok .= 'e'} $z = $frac - $p; $z -= $frac; if($z == -$p) {$ok .= 'f'} $z = $posi - $p; $z -= $posi; if($z == -$p) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1) {print "ok 26\n"} else {print "not ok 26 $ok\n"} $ok = ''; $z = $p + $p; $z -= $p; if($z == $p) {$ok = 'a'} $z = $ui + $p; $z -= $ui; if($z == $p) {$ok .= 'b'} $z = $negi + $p; $z -= $negi; if($z == $p) {$ok .= 'c'} $z = $negd + $p; $z -= $negd; if($z == $p) {$ok .= 'd'} $z = $posd + $p; $z -= $posd; if($z == $p) {$ok .= 'e'} $z = $frac + $p; $z -= $frac; if($z == $p) {$ok .= 'f'} $z = $posi + $p; $z -= $posi; if($z == $p) {$ok .= 'g'} if($ok eq 'abcdefg' && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1) {print "ok 27\n"} else {print "not ok 27 $ok\n"} $ok = ($posi!=$p).($posi==$p).($posi>$p).($posi>=$p).($posi<$p).($posi<=$p).($posi<=>$p); if($ok eq '1011001' && Math::MPFR::get_refcnt($p) == 1) {print "ok 28\n"} else {print "not ok 28\n"} $ok = ($p!=$posi).($p==$posi).($p>$posi).($p>=$posi).($p<$posi).($p<=$posi).($p<=>$posi); if($ok eq '100011-1') {print "ok 29\n"} else {print "not ok 29\n"} Rmpfr_set_ui($z, 2, GMP_RNDN); my $root = sqrt($z); if($root > 1.414 && $root < 1.415 && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($root) == 1) {print "ok 30\n"} else {print "not ok 30\n"} my $root_copy = $root; $root = $root ** 2; $root_copy **= 2; if($root_copy > 1.99999 && $root_copy < 2.00000001 && $root > 1.99999 && $root < 2.00000001 && Math::MPFR::get_refcnt($root) == 1 && Math::MPFR::get_refcnt($root_copy) == 1) {print "ok 31\n"} else {print "not ok 31\n"} $z = $root ** -2; if($z > 0.24999 && $z < 0.25001 && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($root) == 1) {print "ok 32\n"} else {print "not ok 32\n"} $root_copy **= -2; if($root_copy > 0.24999 && $root_copy < 0.25001 && Math::MPFR::get_refcnt($root) == 1 && Math::MPFR::get_refcnt($root_copy) == 1) {print "ok 33\n"} else {print "not ok 33\n"} Rmpfr_set_ui($z, 2, GMP_RNDN); Rmpfr_set_ui($root, 3, GMP_RNDN); $p = $z ** $root; if($p == 8 && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($root) == 1) {print "ok 34\n"} else {print "not ok 34\n"} $z **= $root; if($z == 8 && Math::MPFR::get_refcnt($root) == 1 && Math::MPFR::get_refcnt($z) == 1) {print "ok 35\n"} else {print "not ok 35\n"} Rmpfr_set_ui($z, 2, GMP_RNDN); Rmpfr_set_si($root, -3, GMP_RNDN); $p = $z ** $root; if($p == 0.125 && Math::MPFR::get_refcnt($z) == 1 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($root) == 1) {print "ok 36\n"} else {print "not ok 36\n"} $z **= $root; if($z == 0.125 && Math::MPFR::get_refcnt($root) == 1 && Math::MPFR::get_refcnt($z) == 1) {print "ok 37\n"} else {print "not ok 37\n"} my $s = sin($p); $c = cos($p); $s **= 2; $c **= 2; if($s + $c < 1.0001 && $s + $c > 0.9999 && Math::MPFR::get_refcnt($s) == 1 && Math::MPFR::get_refcnt($c) == 1) {print "ok 38\n"} else {print "not ok 38\n"} Rmpfr_set_ui($c, 10, GMP_RNDN); $s = log($c); if($] >= 5.008) { my $int = int($s); if(int($s) == 2 && $int == 2 && Math::MPFR::get_refcnt($s) == 1 && Math::MPFR::get_refcnt($int) == 1) {print "ok 39\n"} else {print "not ok 39\n"} } else { warn "Skipping test 39 - no overloading of 'int' on perl $]\n"; print "ok 39\n"; } $s = exp($s); if($s < 10.0001 && $s > 0.9999 && Math::MPFR::get_refcnt($s) == 1 && Math::MPFR::get_refcnt($c) == 1) {print "ok 40\n"} else {print "not ok 40\n"} Rmpfr_set_ui($s, 3, GMP_RNDN); $ok = ''; my $y_atan2 = Rmpfr_init(); Rmpfr_set_d($y_atan2, 2.07, GMP_RNDN); my $atan2 = Rmpfr_init(); my $x_atan2 = 2 ** 31 + 2; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'z'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'a'} $x_atan2 *= -1; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'b'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'c'} $x_atan2 = 2; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'd'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'e'} $x_atan2 *= -1; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'f'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'g'} $x_atan2 *= 0.50123; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'h'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'i'} $x_atan2 *= -1; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'j'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'k'} $x_atan2 = "1.988766"; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'l'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'm'} $x_atan2 = "-1.988766"; $atan2 = atan2($y_atan2, $x_atan2); if($atan2 - atan2(2.07, $x_atan2) < 0.0000001 && $atan2 - atan2(2.07, $x_atan2) > -0.0000001) {$ok .= 'n'} $atan2 = atan2($x_atan2, $y_atan2); if($atan2 - atan2($x_atan2, 2.07) < 0.0000001 && $atan2 - atan2($x_atan2, 2.07) > -0.0000001) {$ok .= 'o'} if($ok eq 'zabcdefghijklmno' && Math::MPFR::get_refcnt($atan2) == 1 && Math::MPFR::get_refcnt($y_atan2) == 1) {print "ok 41\n"} else {print "not ok 41 $ok\n"} Rmpfr_set_d($p, 81, GMP_RNDN); $q = $p ** 0.5; if($q == 9) {print "ok 42\n"} else {print "not ok 42\n"} Rmpfr_set_d($p, 2, GMP_RNDN); $q = 0.5 ** $p; if($q == 0.25) {print "ok 43\n"} else {print "not ok 43\n"} Rmpfr_set_d($p, 36, GMP_RNDN); $p **= 0.5; if($p == 6 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 44\n"} else {print "not ok 44\n"} my $mbi = Math::BigInt->new(112345); $ok = ''; eval{$q = $p + $mbi;}; if($@ =~ /Invalid argument/) {$ok = 'a'} eval{$q = $p * $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'b'} eval{$q = $p - $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'c'} eval{$q = $p / $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'd'} eval{$q = $p ** $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'e'} eval{$p += $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'f'} eval{$p *= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'g'} eval{$p -= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'h'} eval{$p /= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'i'} eval{$p **= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'j'} if($ok eq 'abcdefghij') {print "ok 45\n"} else {print "not ok 45 $ok\n"} $mbi = "this is a string"; $ok = ''; $q = $p + $mbi; if($q == $p) {$ok = 'a'} $q = $p * $mbi; if($q == 0) {$ok .= 'b'} $q = $p - $mbi; if($q == $p) {$ok .= 'c'} $q = $p / $mbi; if(Rmpfr_inf_p($q)) {$ok .= 'd'} $q = $p ** $mbi; if($q == 1) {$ok .= 'e'} $q = $p; $p += $mbi; if($q == $p) {$ok .= 'f'} $p *= $mbi; if($p == 0) {$ok .= 'g'} $p -= $mbi; if($p == 0) {$ok .= 'h'} $p /= $mbi; if(Rmpfr_nan_p($p)) {$ok .= 'i'} $p **= $mbi; if($p == 1) {$ok .= 'j'} if($p >$mbi) {$ok .= 'k'} unless($p <$mbi) {$ok .= 'l'} if($p >= $mbi) {$ok .= 'm'} unless($p <= $mbi) {$ok .= 'n'} if($p <=> $mbi) {$ok .= 'o'} unless($p == $mbi) {$ok .= 'p'} if($p != $mbi) {$ok .= 'q'} if($ok eq 'abcdefghijklmnopq') {print "ok 46\n"} else { warn "\$ok: $ok\n"; print "not ok 46 $ok\n"; } $mbi = "-111111111111112.34567879"; Rmpfr_set_si($p, 1234, GMP_RNDN); $q = $p + $mbi; $p = $q - $mbi; $q = $p * $mbi; $p = $q / $mbi; if($p == 1234 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 47\n"} else {print "not ok 47\n"} $p *= $mbi; $p /= $mbi; $p += $mbi; $p -= $mbi; if($p == 1234 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 48\n"} else {print "not ok 48\n"} $q = $mbi + $p; $p = $mbi - $q; if($p == -1234 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 49\n"} else {print "not ok 49\n"} $q = $mbi * $p; $p = $mbi / $q; if($p < -0.00081 && $p > -0.000811 && Math::MPFR::get_refcnt($p) == 1 && Math::MPFR::get_refcnt($q) == 1) {print "ok 50\n"} else {print "not ok 50\n"} Rmpfr_set_str($p, "1234567.123", 10, GMP_RNDN); if($p > $mbi && $p >= $mbi && $mbi < $p && $mbi <= $p && ($p <=> $mbi) > 0 && ($mbi <=> $p) < 0 && $p != $mbi && !($p == $mbi) && Math::MPFR::get_refcnt($p) == 1) {print "ok 51\n"} else {print "not ok 51\n"} $mbi = \$p; $ok = ''; eval{$q = $p + $mbi;}; if($@ =~ /Invalid argument/) {$ok = 'a'} eval{$q = $p * $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'b'} eval{$q = $p - $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'c'} eval{$q = $p / $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'd'} eval{$q = $p ** $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'e'} eval{$p += $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'f'} eval{$p *= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'g'} eval{$p -= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'h'} eval{$p /= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'i'} eval{$p **= $mbi;}; if($@ =~ /Invalid argument/) {$ok .= 'j'} if($ok eq 'abcdefghij') {print "ok 52\n"} else {print "not ok 52 $ok\n"} my $p_copy = $p; $p_copy += 1; if($p_copy - $p == 1) {print "ok 53\n"} else {print "not ok 53\n"} $ok = ''; Rmpfr_set_str($z, '0.0e10', 10, GMP_RNDN); if("$z" eq '0') {$ok = 'a'} Rmpfr_set_str($z, '0.0e-10', 10, GMP_RNDN); if("$z" eq '0') {$ok .= 'b'} Rmpfr_set_str($z, '0.0e10', 10, GMP_RNDN); if("$z" eq '0') {$ok .= 'c'} Rmpfr_set_str($z, '0.0e-10', 10, GMP_RNDN); if("$z" eq '0') {$ok .= 'd'} Rmpfr_set_str($z, '0.0E10', 10, GMP_RNDN); if("$z" eq '0') {$ok .= 'e'} Rmpfr_set_str($z, '0.0E-10', 10, GMP_RNDN); if("$z" eq '0') {$ok .= 'f'} Rmpfr_set_str($z, '1.0', 10, GMP_RNDN); if("$z" eq '1') {$ok .= 'g'} Rmpfr_set_str($z, '-1.0', 10, GMP_RNDN); if("$z" eq '-1') {$ok .= 'h'} if($ok eq 'abcdefgh') {print "ok 54\n"} else {print "not ok 54 $ok\n"} $ok = ''; my $nan = Math::MPFR->new(); $ok .= 'a' if lc(Math::MPFR::overload_string($nan, 10, 0, GMP_RNDN)) eq '@nan@'; my ($man, $exp) = Rmpfr_deref2($nan, 10, 0, GMP_RNDN); $ok .= 'b' if lc($man) eq '@nan@'; my $one = Math::MPFR->new(1); my $minus_one = Math::MPFR->new(-1); my $zero = Math::MPFR->new(0); my $minus_zero = Math::MPFR->new(-0.0); my $inf = $one / $zero; $ok .= 'c' if lc(Math::MPFR::overload_string($inf)) eq '@inf@'; $inf = $minus_one / $minus_zero; $ok .= 'd' if lc(Math::MPFR::overload_string($inf)) eq '@inf@'; $inf = $one / $minus_zero; $ok .= 'e' if lc(Math::MPFR::overload_string($inf)) eq '-@inf@'; $inf = $minus_one / $zero; $ok .= 'f' if lc(Math::MPFR::overload_string($inf)) eq '-@inf@'; $ok .= 'g' if Math::MPFR::overload_string($zero) eq '0'; $ok .= 'h' if Math::MPFR::overload_string($minus_zero) eq '-0'; my $minus_zero2 = Math::MPFR->new(-0); $ok .= 'i' if Math::MPFR::overload_string($minus_zero2) eq '0'; $ok .= 'j' if lc(Math::MPFR::overload_string($zero / $minus_zero)) eq '@nan@'; if($ok eq 'abcdefghij') {print "ok 55\n"} else {print "not ok 55 $ok\n"} $ok = ''; $ok .= 'A' if $nan; $ok .= $nan ? 'B' : 'b'; $ok .= 'c' if $one; $ok .= 'D' if $zero; $ok .= 'e' if !$nan; $ok .= $one ? 'f' : 'F'; $ok .= $zero ? 'G' : 'g'; if($ok eq 'bcefg') {print "ok 56\n"} else {print "not ok 56 $ok\n"} my $next = Math::MPFR->new(200); if(Math::MPFR::overload_string($next) eq '2e2') {print "ok 57\n"} else {print "not ok 57\n"} $zero *= -1; if(Math::MPFR::overload_string($zero) eq '-0') {print "ok 58\n"} else {print "not ok 58\n"} $zero ? print "not ok 59\n" : print "ok 59\n"; # testing overload_copy subroutine precision handling. # current default precision is 200. $ok = ''; my $mpfr1 = Rmpfr_init2(100); Rmpfr_set_ui($mpfr1, 1234, GMP_RNDN); my $mpfr2 = $mpfr1; $ok .= 'a' if Rmpfr_get_prec($mpfr2) == 100; $mpfr2 *= 2; $ok .= 'b' if $mpfr2 == 2468 && $mpfr1 == 1234 && Rmpfr_get_prec($mpfr1) == 100 && Rmpfr_get_prec($mpfr2) == 100; my $mpfr3 = $mpfr1; $mpfr1 *= 2; $ok .= 'c' if $mpfr1 == 2468 && $mpfr3 == 1234 && Rmpfr_get_prec($mpfr1) == 100 && Rmpfr_get_prec($mpfr3) == 100; if($ok eq 'abc'){print "ok 60\n"} else {print "not ok 60 $ok\n"} $ok = ''; $mpfr1 += 0.5; $mpfr1++; $ok .= 'a' if $mpfr1 == 2469.5; ++$mpfr1; $ok .= 'b' if $mpfr1 == 2470.5; $mpfr1--; $ok .= 'c' if $mpfr1 == 2469.5; --$mpfr1; $ok .= 'd' if $mpfr1 == 2468.5; if($ok eq 'abcd') {print "ok 61\n"} else { warn "\$ok: $ok\n"; print "not ok 61\n"; } my $unblessed = Rmpfr_init_nobless(); my $blessed = Rmpfr_init(); if(Math::MPFR::_isobject($blessed)) { print "ok 62\n"} else {print "not ok 62\n"} unless(Math::MPFR::_isobject($unblessed)) { print "ok 63\n"} else {print "not ok 63\n"} if(Math::MPFR::nnumflag() == 17) { print "ok 64\n" } else { warn "nnumflag(): expected 17, got ", Math::MPFR::nnumflag(), "\n"; print "not ok 64\n"; } Math::MPFR::clear_nnum(); if(Math::MPFR::nnumflag() == 0) { print "ok 65\n" } else { warn "nnumflag(): expected 0, got ", Math::MPFR::nnumflag(), "\n"; print "not ok 65\n"; } Math::MPFR::set_nnum(16); if(Math::MPFR::nnumflag() == 16) { print "ok 66\n" } else { warn "nnumflag(): expected 16, got ", Math::MPFR::nnumflag(), "\n"; print "not ok 66\n"; } sub adjust { if($_[0]) { if($_[0] > 0) { return 1} return -1; } return 0; } Math-MPFR-3.32/t/overload_cross_class.t0000644000076400010400000001451412660557734021431 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..3\n"; my $message = ''; my ($have_mpz, $have_mpf, $have_mpq) = (1, 1, 1); my ($rop, $op, $mpz, $mpf, $mpq, $mpz_power, $mpf_power, $mpq_power); $op = Math::MPFR->new(307.5); eval{require Math::GMPz;}; if($@) { $have_mpz = 0; $message .= " Math::GMPz - currently not installed\n"; } else { $mpz = Math::GMPz->new(10); $mpz_power = Math::GMPz->new(4); $message .= " Math::GMPz - we only have $Math::GMPz::VERSION\n" if $Math::GMPz::VERSION < 0.35; } eval{require Math::GMPf;}; if($@) { $have_mpf = 0; $message .= " Math::GMPf - currently not installed\n"; } else { $mpf = Math::GMPf->new(10.0); $mpf_power = Math::GMPf->new(4.0); $message .= " Math::GMPf - we only have $Math::GMPf::VERSION\n" if $Math::GMPf::VERSION < 0.35; } eval{require Math::GMPq;}; if($@) { $have_mpq = 0; $message .= " Math::GMPq - currently not installed\n"; } else { $mpq = Math::GMPq->new(10.0); $mpq_power = Math::GMPq->new(4); $message .= " Math::GMPq - we only have $Math::GMPq::VERSION\n" if $Math::GMPq::VERSION < 0.35; } if($message) { $message = "\n Version 0.35 (or later) of the following modules is needed for a more \n" . " complete implementation of cross_class overloading:\n" . $message; } warn "$message\n" if $message; my $ok = ''; if($have_mpz) { $rop = $op + $mpz; if(ref($rop) eq 'Math::MPFR'){$ok .= 'a'} else { warn "1a: ref: ", ref($rop), "\n"} if($rop == 317.5) {$ok .= 'b'} else {warn "1b: \$rop: $rop\n"} $rop = $op * $mpz; if(ref($rop) eq 'Math::MPFR'){$ok .= 'c'} else { warn "1c: ref: ", ref($rop), "\n"} if($rop == 3075) {$ok .= 'd'} else {warn "1d: \$rop: $rop\n"} $rop = $op - $mpz; if(ref($rop) eq 'Math::MPFR'){$ok .= 'e'} else { warn "1e: ref: ", ref($rop), "\n"} if($rop == 297.5) {$ok .= 'f'} else {warn "1f: \$rop: $rop\n"} $rop = $op / $mpz; if(ref($rop) eq 'Math::MPFR'){$ok .= 'g'} else { warn "1g: ref: ", ref($rop), "\n"} if($rop == 30.75) {$ok .= 'h'} else {warn "1h: \$rop: $rop\n"} ###################################### $rop = $op ** $mpz_power; if(ref($rop) eq 'Math::MPFR'){$ok .= 'i'} else { warn "1i: ref: ", ref($rop), "\n"} if($rop == 8940884414.0625) {$ok .= 'j'} else {warn "1j: \$rop: $rop\n"} $op += $mpz; if($op == 317.5) {$ok .= 'k'} else {warn "1k: \$op: $op\n"} $op -= $mpz; if($op == 307.5) {$ok .= 'l'} else {warn "1l: \$op: $op\n"} $op *= $mpz; if($op == 3075) {$ok .= 'm'} else {warn "1m: \$op: $op\n"} $op /= $mpz; if($op == 307.5) {$ok .= 'n'} else {warn "1n: \$op: $op\n"} $op **= $mpz_power; if($op == 8940884414.0625) {$ok .= 'o'} else {warn "1o: \$op: $op\n"} Rmpfr_set_d($op, 307.5, GMP_RNDN); # Restore to original value ###################################### if($ok eq 'abcdefghijklmno') {print "ok 1\n"} else { warn "\$ok: $ok\n"; print "not ok 1\n"; } } # close mpz else { warn "\nSkipping test 1 - no Math::GMPz\n"; print "ok 1\n"; } $ok = ''; if($have_mpf) { $rop = $op + $mpf; if(ref($rop) eq 'Math::MPFR'){$ok .= 'a'} else { warn "2a: ref: ", ref($rop), "\n"} if($rop == 317.5) {$ok .= 'b'} else {warn "2b: \$rop: $rop\n"} $rop = $op * $mpf; if(ref($rop) eq 'Math::MPFR'){$ok .= 'c'} else { warn "2c: ref: ", ref($rop), "\n"} if($rop == 3075) {$ok .= 'd'} else {warn "2d: \$rop: $rop\n"} $rop = $op - $mpf; if(ref($rop) eq 'Math::MPFR'){$ok .= 'e'} else { warn "2e: ref: ", ref($rop), "\n"} if($rop == 297.5) {$ok .= 'f'} else {warn "2f: \$rop: $rop\n"} $rop = $op / $mpf; if(ref($rop) eq 'Math::MPFR'){$ok .= 'g'} else { warn "2g: ref: ", ref($rop), "\n"} if($rop == 30.75) {$ok .= 'h'} else {warn "2h: \$rop: $rop\n"} ###################################### $rop = $op ** $mpf_power; if(ref($rop) eq 'Math::MPFR'){$ok .= 'i'} else { warn "2i: ref: ", ref($rop), "\n"} if($rop == 8940884414.0625) {$ok .= 'j'} else {warn "2j: \$rop: $rop\n"} $op += $mpf; if($op == 317.5) {$ok .= 'k'} else {warn "2k: \$op: $op\n"} $op -= $mpf; if($op == 307.5) {$ok .= 'l'} else {warn "2l: \$op: $op\n"} $op *= $mpf; if($op == 3075) {$ok .= 'm'} else {warn "2m: \$op: $op\n"} $op /= $mpf; if($op == 307.5) {$ok .= 'n'} else {warn "2n: \$op: $op\n"} $op **= $mpf_power; if($op == 8940884414.0625) {$ok .= 'o'} else {warn "2o: \$op: $op\n"} Rmpfr_set_d($op, 307.5, GMP_RNDN); # Restore to original value ###################################### if($ok eq 'abcdefghijklmno') {print "ok 2\n"} else { warn "\$ok: $ok\n"; print "not ok 2\n"; } } # close mpf else { warn "\nSkipping test 2 - no Math::GMPf\n"; print "ok 2\n"; } $ok = ''; if($have_mpq) { $rop = $op + $mpq; if(ref($rop) eq 'Math::MPFR'){$ok .= 'a'} else { warn "3a: ref: ", ref($rop), "\n"} if($rop == 317.5) {$ok .= 'b'} else {warn "3b: \$rop: $rop\n"} $rop = $op * $mpq; if(ref($rop) eq 'Math::MPFR'){$ok .= 'c'} else { warn "3c: ref: ", ref($rop), "\n"} if($rop == 3075) {$ok .= 'd'} else {warn "3d: \$rop: $rop\n"} $rop = $op - $mpq; if(ref($rop) eq 'Math::MPFR'){$ok .= 'e'} else { warn "3e: ref: ", ref($rop), "\n"} if($rop == 297.5) {$ok .= 'f'} else {warn "3f: \$rop: $rop\n"} $rop = $op / $mpq; if(ref($rop) eq 'Math::MPFR'){$ok .= 'g'} else { warn "3g: ref: ", ref($rop), "\n"} if($rop == 30.75) {$ok .= 'h'} else {warn "3h: \$rop: $rop\n"} ###################################### $rop = $op ** $mpq_power; if(ref($rop) eq 'Math::MPFR'){$ok .= 'i'} else { warn "3i: ref: ", ref($rop), "\n"} if($rop == 8940884414.0625) {$ok .= 'j'} else {warn "3j: \$rop: $rop\n"} $op += $mpq; if($op == 317.5) {$ok .= 'k'} else {warn "3k: \$op: $op\n"} $op -= $mpq; if($op == 307.5) {$ok .= 'l'} else {warn "3l: \$op: $op\n"} $op *= $mpq; if($op == 3075) {$ok .= 'm'} else {warn "3m: \$op: $op\n"} $op /= $mpq; if($op == 307.5) {$ok .= 'n'} else {warn "3n: \$op: $op\n"} $op **= $mpq_power; if($op == 8940884414.0625) {$ok .= 'o'} else {warn "3o: \$op: $op\n"} Rmpfr_set_d($op, 307.5, GMP_RNDN); # Restore to original value ###################################### if($ok eq 'abcdefghijklmno') {print "ok 3\n"} else { warn "\$ok: $ok\n"; print "not ok 3\n"; } } # close mpq else { warn "\nSkipping test 3 - no Math::GMPq\n"; print "ok 3\n"; } Math-MPFR-3.32/t/overload_float128.t0000644000076400010400000000472112660557734020452 0ustar sisyphusAdministratorsuse strict; use warnings; use Config; use Math::MPFR qw(:mpfr); if(!Math::MPFR::_can_pass_float128()) { print "1..1\n"; warn "\n Skipping all tests - can't pass __float128 type\n"; print "ok 1\n"; exit 0; } if($Config{nvtype} ne '__float128') { print "1..1\n"; warn "\n What the ... ?? This shouldn't be possible\n"; print "not ok 1\n"; exit 0; } my $t = 1; print "1..$t\n"; Rmpfr_set_default_prec(113); my $ok = ''; my $rop = Math::MPFR->new(2.13); if($rop == 2.13) {$ok .= 'a'} else {warn "\n Expected:2.13 Got $rop\n"} $rop = Math::MPFR->new(1.0); $rop += 2.13; if($rop == 3.13) {$ok .= 'b'} else {warn "\n Expected:3.13 Got $rop\n"} $rop -= 2.13; if($rop == 1.0) {$ok .= 'c'} else {warn "\n Expected:1.0 Got $rop\n"} $rop *= 2.13; if($rop == 2.13) {$ok .= 'd'} else {warn "\n Expected:2.13 Got $rop\n"} $rop /= 2.13; if($rop == 1.0) {$ok .= 'e'} else {warn "\n Expected:1.0 Got $rop\n"} my $rop1 = $rop + 1.13; if($rop1 == 2.13) {$ok .= 'f'} else {warn "\n Expected:2.13 Got $rop1\n"} $rop1 = $rop - 2.13; if($rop1 == -1.13) {$ok .= 'g'} else {warn "\n Expected:-0.13 Got $rop1\n"} $rop1 = $rop * 2.13; if($rop1 == 2.13) {$ok .= 'h'} else {warn "\n Expected:2.13 Got $rop1\n"} $rop += 1.13; if($rop == 2.13) {$ok .= 'i'} else {warn "\n Expected:2.13 Got $rop\n"} $rop1 = $rop / 2.13; if($rop1 == 1.0) {$ok .= 'j'} else {warn "\n Expected:1.0 Got $rop1\n"} $rop1 = 2.13 / $rop; if($rop1 == 1.0) {$ok .= 'k'} else {warn "\n Expected:1.0 Got $rop1\n"} $rop1 = 3.13 - $rop; if($rop1 == 1.0) {$ok .= 'l'} else {warn "\n Expected:1.0 Got $rop1\n"} if(!($rop <=> 2.13)) {$ok .= 'm'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop != 2.14) {$ok .= 'n'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop <= 2.14) {$ok .= 'o'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop <= 2.13) {$ok .= 'p'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop < 2.14) {$ok .= 'q'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop > 2.12) {$ok .= 'r'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop >= 2.12) {$ok .= 's'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop >= 2.13) {$ok .= 't'} else {warn "\n Expected:2.13 Got $rop\n"} if($rop ** 2.13 == 2.13 ** $rop) {$ok .= 'u'} else {warn $rop ** 2.13, " != ", 2.13 ** $rop, "\n"} $rop1 = $rop; $rop1 **= 2.13; if($rop1 == 2.13 ** $rop) {$ok .= 'v'} else {warn $rop ** 2.13, " != ", 2.13 ** $rop, "\n"} if($ok eq 'abcdefghijklmnopqrstuv') {print "ok 1\n"} else { warn "\n\$ok: $ok\n"; print "not ok 1\n"; } Math-MPFR-3.32/t/pod.t0000644000076400010400000000045312660557734015777 0ustar sisyphusAdministratorseval "use Test::Pod 1.00"; if($@) { print "1..1\n"; warn "Skipping test 1 - no recent version of Test::Pod installed\n"; print "ok 1\n"; } else { warn "\nTest::Pod version: $Test::Pod::VERSION\n"; warn "\nPod::Simple version: $Pod::Simple::VERSION\n"; Test::Pod::all_pod_files_ok(); } Math-MPFR-3.32/t/printf.t0000644000076400010400000001646012660557734016524 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::BigInt; use Math::MPFR qw(:mpfr); print "1..5\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(80); my $ok = ''; my $buf; my $copy = $buf; my $ul = 123; my $ret; my $mpfr1 = Math::MPFR->new(1234567.625); $ret = Rmpfr_printf("For testing: %.30Rf\n", $mpfr1); if($ret == 52) {$ok .= 'a'} else {warn "1a: $ret\n"} $ok .= 'b' if $ret == Rmpfr_printf("For testing: %.30RNf\n", $mpfr1); $ok .= 'c' if $ret == Rmpfr_printf("For testing: %.30R*f\n", GMP_RNDN, $mpfr1); $ok .= 'd' if $ret == Rmpfr_fprintf(\*STDOUT, "For testing: %.30Rf\n", $mpfr1); $ok .= 'e' if $ret == Rmpfr_fprintf(\*STDOUT, "For testing: %.30RNf\n", $mpfr1); $ok .= 'f' if $ret == Rmpfr_fprintf(\*STDOUT, "For testing: %.30R*f\n", GMP_RNDZ, $mpfr1); $ok .= 'g' if $ret == Rmpfr_sprintf($buf, "For testing: %.30Rf\n", $mpfr1, 200); $ok .= 'h' if $ret == Rmpfr_sprintf($buf, "For testing: %.30RNf\n", $mpfr1, 200); $ok .= 'i' if $ret == Rmpfr_sprintf($buf, "For testing: %.30R*f\n", GMP_RNDN, $mpfr1, 60); if(length($buf) == 52) {$ok .= 'j'} else {warn "length \$buf: ", length($buf), "\n"} Math::MPFR::_readonly_on($buf); eval {Rmpfr_sprintf($buf, "For testing: %.30R*f\n", GMP_RNDN, $mpfr1, 200);}; if($@ =~ /Modification of a read-only value attempted/) {$ok .= 'k'} else { warn "\n1k: \$\@: $@\n"} Math::MPFR::_readonly_off($buf); Rmpfr_sprintf($buf, "For testing: %.30Rf\n", $mpfr1, 200); $ok .= 'm' if "For testing: 1234567.625000000000000000000000000000\n" eq $buf; Rmpfr_sprintf($buf, "For testing: %.30RNf\n", $mpfr1, 200); $ok .= 'n' if "For testing: 1234567.625000000000000000000000000000\n" eq $buf; Rmpfr_sprintf($buf, "For testing: %.30R*f\n", GMP_RNDU, $mpfr1, 200); $ok .= 'o' if "For testing: 1234567.625000000000000000000000000000\n" eq $buf; Rmpfr_sprintf($buf, "For some more testing: %.30Rf\n", $mpfr1, 200); $ok .= 'p' if "For some more testing: 1234567.625000000000000000000000000000\n" eq $buf; Rmpfr_sprintf($buf, "For some more testing: %.30RNf\n", $mpfr1, 200); $ok .= 'q' if "For some more testing: 1234567.625000000000000000000000000000\n" eq $buf; Rmpfr_sprintf($buf, "For some more testing: %.30R*f\n", GMP_RNDN, $mpfr1, 200); $ok .= 'r' if "For some more testing: 1234567.625000000000000000000000000000\n" eq $buf; Rmpfr_sprintf ($buf, "%Pu\n", prec_cast(Rmpfr_get_prec($mpfr1)), 200); if($buf == 80) {$ok .= 's'} else {warn "1s: $buf\n"} Rmpfr_sprintf($buf, "%.30Rb\n", $mpfr1, 200); if(lc($buf) eq "1.001011010110100001111010000000p+20\n") {$ok .= 't'} else {warn "1t: $buf\n"} Rmpfr_sprintf($buf, "%.30RNb\n", $mpfr1, 200); if(lc($buf) eq "1.001011010110100001111010000000p+20\n") {$ok .= 'u'} else {warn "1u: $buf\n"} Rmpfr_sprintf($buf, "%.30R*b\n", GMP_RNDD, $mpfr1, 200); if(lc($buf) eq "1.001011010110100001111010000000p+20\n") {$ok .= 'v'} else {warn "1v: $buf\n"} $ret = Rmpfr_printf("hello world", 0); if($ret == 11) {$ok .= 'w'} else {warn "1w: $ret\n"} $ret = Rmpfr_printf("$ul", 0); if($ret == 3) {$ok .= 'x'} else {warn "1x: $ret\n"} $ret = Rmpfr_fprintf(\*STDOUT, "hello world", 0); if($ret == 11) {$ok .= 'y'} else {warn "1y: $ret\n"} $ret = Rmpfr_fprintf(\*STDOUT, "$ul", 0); if($ret == 3) {$ok .= 'z'} else {warn "1z: $ret\n"} $ret = Rmpfr_sprintf($buf, "hello world", 0, 15); if($ret == 11) {$ok .= 'A'} else {warn "1A: $ret\n"} if($buf eq 'hello world') {$ok .= 'B'} else {warn "1B: $buf\n"} $ret = Rmpfr_sprintf($buf, "$ul", 0, 5); if($ret == 3) {$ok .= 'C'} else {warn "\n1C: $ret $buf\n"} if($buf eq "123") {$ok .= 'D'} else {warn "\n1D: $buf\n"} if(!$copy) {$ok .= 'E'} else { warn "\n1l: \$copy: $copy\n"; } Rmpfr_printf("\n", 0); # Otherwise Test::Harness gets confused if($ok eq 'abcdefghijkmnopqrstuvwxyzABCDE') {print "ok 1\n"} else { warn "got: $ok\n"; print "not ok 1 $ok\n"; } $ok = ''; my $mbi = Math::BigInt->new(123); eval {Rmpfr_printf("%RNd", $mbi);}; if($@ =~ /Unrecognised object/) {$ok .= 'a'} else {warn "2a got: $@\n"} eval {Rmpfr_fprintf(\*STDOUT, "%RDd", $mbi);}; if($@ =~ /Unrecognised object/) {$ok .= 'b'} else {warn "2b got: $@\n"} eval {Rmpfr_sprintf($buf, "%RNd", $mbi, 200);}; if($@ =~ /Unrecognised object/) {$ok .= 'c'} else {warn "2c got: $@\n"} # no longer have Rmpfr_sprintf_ret(). #eval {Rmpfr_sprintf_ret("%RUd", $mbi, 200);}; #if($@ =~ /Unrecognised object/) {$ok .= 'd'} #else {warn "2d got: $@\n"} $ok .= 'd'; eval {Rmpfr_fprintf(\*STDOUT, "%R*d", GMP_RNDN, $mbi, $ul);}; if($@ =~ /must take 3 or 4 arguments/) {$ok .= 'e'} else {warn "2e got: $@\n"} eval {Rmpfr_sprintf($buf, "%R*d", GMP_RNDN, $mbi, $ul, 50);}; if($@ =~ /must take 4 or 5 arguments/) {$ok .= 'f'} else {warn "2f got: $@\n"} eval {Rmpfr_sprintf("%RNd", $mbi);}; if($@ =~ /must take 4 or 5 arguments/) {$ok .= 'g'} else {warn "2g got: $@\n"} eval {Rmpfr_fprintf(\*STDOUT, "%R*d", 4, $mbi);}; if(MPFR_VERSION_MAJOR >= 3) { if($@ =~ /Unrecognised object supplied/) {$ok .= 'h'} else {warn "2h got: $@\n"} } else { if($@ =~ /Invalid 3rd argument/) {$ok .= 'h'} else {warn "2h got: $@\n"} } eval {Rmpfr_sprintf("%R*d", 4, $mbi, 50);}; # Changed in response to http://www.cpantesters.org/cpan/report/2c6e2406-6bf5-1014-981d-364b06b49268 # which used mpfr-2.4.2 #if(MPFR_VERSION_MAJOR >= 3) { if($@ =~ /Unrecognised object supplied/) {$ok .= 'i'} else {warn "2i got: $@\n"} #} #else { # if($@ =~ /Invalid 3rd argument/) {$ok .= 'i'} # else {warn "2i got: $@\n"} #} eval {Rmpfr_printf("%R*d", 4, $mbi);}; if(MPFR_VERSION_MAJOR >= 3) { if($@ =~ /Unrecognised object supplied/) {$ok .= 'j'} else {warn "2j got: $@\n"} } else { if($@ =~ /Invalid 2nd argument/) {$ok .= 'j'} else {warn "2j got: $@\n"} } if($ok eq 'abcdefghij') {print "ok 2\n"} else {print "not ok 2 $ok\n"} # $mpfr1 contains the value 1.234567625e6. $ok = ''; $ret = Rmpfr_snprintf($buf, 5, "%.0Rf", $mpfr1, 10); if($buf eq '1234' && $ret == 7) {$ok .= 'a'} else {warn "3a: $buf $ret\n"} $ret = Rmpfr_snprintf($buf, 6, "%.0Rf", $mpfr1, 10); if($ret == 7) {$ok .= 'b'} else {warn "3b: $ret\n"} if($buf eq '12345') {$ok .= 'c'} else {warn "3c: $buf\n"} if($ok eq 'abc') {print "ok 3\n"} else {print "not ok 3\n"} $ok = ''; $ret = Rmpfr_snprintf($buf, 7, "%.0R*f", GMP_RNDD, $mpfr1, 10); if($buf eq '123456' && $ret == 7) {$ok .= 'a'} else {warn "4a: $ret\n"} #Rmpfr_printf("%.0R*f", GMP_RNDD, $mpfr1); $ret = Rmpfr_snprintf($buf, 6, "%.0R*f", GMP_RNDD, $mpfr1 / 10, 10); #Rmpfr_printf("%.0R*f", GMP_RNDD, $mpfr1 / 10); if($ret == 6) {$ok .= 'b'} else {warn "4b: $ret\n"} if($buf eq '12345') {$ok .= 'c'} else {warn "4c: $buf\n"} if($ok eq 'abc') {print "ok 4\n"} else { warn "4: \$ok: $ok\n"; print "not ok 4\n"; } $ok = ''; eval{Rmpfr_fprintf(\*STDOUT, "%Pu\n", GMP_RNDN, 123);}; if($@ =~ /In Rmpfr_fprintf: The rounding argument is specific to Math::MPFR objects/) {$ok .= 'a'} else {warn "\n5a: \$\@: $@\n"} eval{Rmpfr_sprintf ($buf, "%Pu\n", GMP_RNDN, 123, 100);}; if($@ =~ /In Rmpfr_sprintf: The rounding argument is specific to Math::MPFR objects/) {$ok .= 'b'} else {warn "\n5b: \$\@: $@\n"} eval{Rmpfr_snprintf ($buf, 10, "%Pu\n", GMP_RNDN, 123, 100);}; if($@ =~ /In Rmpfr_snprintf: The rounding argument is specific to Math::MPFR objects/) {$ok .= 'c'} else {warn "\n5c: \$\@: $@\n"} if($ok eq 'abc') {print "ok 5\n"} else { warn "5: \$ok: $ok\n"; print "not ok 5\n"; } Math-MPFR-3.32/t/P_specifier.t0000644000076400010400000000436512660557734017453 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); print "1..6\n"; my $prec = 100009; my $fh; my $file = 'p_spec.txt'; my $ok = ''; my $bytes = 7; eval{Rmpfr_printf("hello world\n", 0);}; if($@) { warn "1a: \$\@: $@\n"; } else {$ok .= 'a'}; eval{Rmpfr_printf("%Pu\n", 0, 0);}; if($@ =~ /In Rmpfr_printf: The rounding argument is specific to Math::MPFR objects/) { $ok .= 'b' } else {warn "1b: \$\@: $@\n"}; eval{Rmpfr_printf("%Pu\n", prec_cast($prec));}; if($@) { warn "1c: \$\@: $@\n"; } else {$ok .= 'c'}; eval{Rmpfr_printf("%Pu\n", 0, prec_cast($prec));}; if($@ =~ /You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_printf/) { $ok .= 'd' } else {warn "1d: \$\@: $@\n"}; if($ok eq 'abcd') {print "ok 1\n"} else {print "not ok 1\n"} $ok = ''; my $o = open($fh, '>', $file); if($o) { Rmpfr_fprintf($fh, "%Pu\n", prec_cast($prec)); eval{Rmpfr_fprintf($fh, "%Pu\n", GMP_RNDN, prec_cast($prec));}; if($@ =~ /You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_fprintf/) {$ok = 'a'} else {warn "2a: \$\@: $@\n"} close $fh; if(open(RD, '<', $file)) { my $num = ; chomp $num; if($num == $prec) {$ok .= 'b'} } else { warn "Failed to open $file for reading: $!";} if($ok eq 'ab') {print "ok 2\n"} else { warn "\$ok: $ok\n"; print "not ok 2\n"; } } else { warn "Failed to open $file for writing: $!"; warn "\nSkipping test 2 - couldn't open $file\n"; print "ok 2\n"; } my $buf; Rmpfr_sprintf ($buf, "%Pu\n", prec_cast($prec), 200); if($buf == 100009) {print "ok 3\n"} else { warn "\$buf: $buf\n"; print "not ok 3\n"; } eval{Rmpfr_sprintf ($buf, "%Pu\n", GMP_RNDN, prec_cast($prec), 100);}; if($@ =~ /You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_sprintf/) {print "ok 4\n"} else { warn "4: \$\@: $@\n"; print "not ok 4\n"; } Rmpfr_snprintf ($buf, $bytes, "%Pu\n", prec_cast($prec), 200); chomp $buf; if($buf == 100009) {print "ok 5\n"} else { warn "\$buf: $buf\n"; print "not ok 5\n"; } eval{Rmpfr_snprintf ($buf, $bytes, "%Pu\n", GMP_RNDN, prec_cast($prec), 10);}; if($@ =~ /You've provided both a rounding arg and a Math::MPFR::Prec object to Rmpfr_snprintf/) {print "ok 6\n"} else { warn "6: \$\@: $@\n"; print "not ok 6\n"; } Math-MPFR-3.32/t/remainder.t0000644000076400010400000000330412660557734017161 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..2\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $ok = ''; my $numerator = Math::MPFR->new(11.5); my $denominator = Math::MPFR->new(3); my $zero = Math::MPFR->new(0); my $inf = Math::MPFR->new(1); $inf /= $zero; my $rop = Rmpfr_init(); Rmpfr_remainder($rop, $numerator, $denominator, GMP_RNDN); if($rop == -0.5) {$ok .= 'a'} Rmpfr_fmod($rop, $numerator, $denominator, GMP_RNDN); if($rop == 2.5) {$ok .= 'b'} Rmpfr_remainder($rop, $numerator, $zero, GMP_RNDN); if(Rmpfr_nan_p($rop)) {$ok .= 'c'} Rmpfr_fmod($rop, $numerator, $zero, GMP_RNDN); if(Rmpfr_nan_p($rop)) {$ok .= 'd'} Rmpfr_remquo($rop, $numerator, $zero, GMP_RNDN); if(Rmpfr_nan_p($rop)) {$ok .= 'e'} Rmpfr_remainder($rop, $inf, $denominator, GMP_RNDN); if(Rmpfr_nan_p($rop)) {$ok .= 'f'} Rmpfr_fmod($rop, $inf, $denominator, GMP_RNDN); if(Rmpfr_nan_p($rop)) {$ok .= 'g'} Rmpfr_remquo($rop, $inf, $denominator, GMP_RNDN); if(Rmpfr_nan_p($rop)) {$ok .= 'h'} Rmpfr_remainder($rop, $numerator, $inf, GMP_RNDN); if($rop == $numerator) {$ok .= 'i'} Rmpfr_fmod($rop, $numerator, $inf, GMP_RNDN); if($rop == $numerator) {$ok .= 'j'} Rmpfr_remquo($rop, $numerator, $inf, GMP_RNDN); if($rop == $numerator) {$ok .= 'k'} if($ok eq 'abcdefghijk') {print "ok 1\n"} else {print "not ok 1 $ok \n"} $ok = ''; $numerator += 30.5; # 42 $denominator += 14; # 17 my($q, $ret) = Rmpfr_remquo($rop, $numerator, $denominator, GMP_RNDN); if($q == 2) {$ok .= 'a'} if($rop == 8) {$ok .= 'b'} if($ok eq 'ab') {print "ok 2\n"} else {print "not ok 2 $ok\n"} Math-MPFR-3.32/t/Rmpfr_get_q.t0000644000076400010400000000405312660557734017462 0ustar sisyphusAdministratorsuse warnings; use strict; use Config; use Math::MPFR qw(:mpfr); eval {require Math::GMPq; Math::GMPq->import(':mpq');}; if($@) { print "1..1\n"; warn "\nSkipping all tests - Couldn't load Math::GMPq\n"; print "ok 1\n"; exit 0; } print "1..8\n"; my $nan = Math::MPFR->new(); my $ninf = Math::MPFR->new(-1) / Math::MPFR->new(0); my $pinf = Math::MPFR->new(1) / Math::MPFR->new(0); my $pzero = Math::MPFR->new(0); my $nzero = Math::MPFR->new(0) * Math::MPFR->new(-1); my $ok; my $q = Math::GMPq->new(); $ok .= 'a' unless Rmpfr_erangeflag_p(); Rmpfr_get_q($q, $nan); if($q == 0) {print "ok 1\n"} else { warn "\nExpected 0, got $q\n"; print "not ok 1\n"; } $ok .= 'b' if Rmpfr_erangeflag_p(); Rmpfr_clear_erangeflag(); $ok .= 'c' unless Rmpfr_erangeflag_p(); Rmpfr_get_q($q, $ninf); if($q == 0) {print "ok 2\n"} else { warn "\nExpected 0, got $q\n"; print "not ok 2\n"; } $ok .= 'd' if Rmpfr_erangeflag_p(); Rmpfr_clear_erangeflag(); $ok .= 'e' unless Rmpfr_erangeflag_p(); Rmpfr_get_q($q, $pinf); if($q == 0) {print "ok 3\n"} else { warn "\nExpected 0, got $q\n"; print "not ok 3\n"; } $ok .= 'f' if Rmpfr_erangeflag_p(); Rmpfr_clear_erangeflag(); $ok .= 'g' unless Rmpfr_erangeflag_p(); Rmpfr_get_q($q, $pzero); if($q == 0) {print "ok 4\n"} else { warn "\nExpected 0, got $q\n"; print "not ok 4\n"; } Rmpfr_get_q($q, $nzero); if($q == 0) {print "ok 5\n"} else { warn "\nExpected 0, got $q\n"; print "not ok 5\n"; } my $val = Rmpfr_init2(121); Rmpfr_set_d($val, 2.0, MPFR_RNDN); $val **= 0.5; #print "$val\n"; Rmpfr_get_q($q, $val); if(Rmpfr_cmp_q($val, $q) == 0) {print "ok 6\n"} else { warn "\n\$val ($val) != \$q ($q)\n"; print "not ok 6\n"; } $ok .= 'h' unless Rmpfr_erangeflag_p(); if($ok eq 'abcdefgh') {print "ok 7\n"} else { warn "\nExpected 'abcdefgh', got '$ok'\n"; print "not ok 7\n"; } my $check = Rmpfr_init2(Rmpfr_get_prec($val) * 2); Rmpfr_set($check, $val, MPFR_RNDN); $check **= 2.0; if(Rmpfr_cmp_q($check, $q * $q) == 0) {print "ok 8\n"} else { warn "\n$check != ", $q * $q, "\n"; print "not ok 8\n"; } Math-MPFR-3.32/t/set_NV.t0000644000076400010400000000132312660557734016410 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); print "1..2\n"; Rmpfr_set_default_prec(70); my $fr1 = Rmpfr_init(); my $fr2 = Rmpfr_init(); my ($ret1, $ret2); $ret1 = Rmpfr_set_NV($fr1, sqrt(2.0), MPFR_RNDN); if(Math::MPFR::_has_longdouble() && !Math::MPFR::_can_pass_float128()) { $ret2 = Rmpfr_set_ld($fr2, sqrt(2.0), MPFR_RNDN); } elsif(Math::MPFR::_can_pass_float128()) { $ret2 = Rmpfr_set_float128($fr2, sqrt(2.0), MPFR_RNDN); } else { $ret2 = Rmpfr_set_d($fr2, sqrt(2.0), MPFR_RNDN); } if($fr1 == $fr2) {print "ok 1\n"} else { warn "\n\$fr1: $fr1\n\$fr2: $fr2\n"; print "not ok 1\n"; } if($ret1 == $ret2) {print "ok 2\n"} else { warn "\n\$ret1: $ret1\n\$ret2: $ret2\n"; print "not ok 2\n"; } Math-MPFR-3.32/t/set_str.t0000644000076400010400000001044512660557734016702 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); print "1..15\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $hex = '0xabcde'; my $dec = 703710; my $dec_str = '703710'; my $bin = '0b10101011110011011110'; my ($pest, $b_hex, $b_bin, $b_dec, $b_dec2, $b_hex2, $b_bin2, $two, $rev, $z); ($b_hex, $pest) = Rmpfr_init_set_str($hex, 0, GMP_RNDN); if($b_hex == $hex && $b_hex == $dec && $b_hex == '703710') {print "ok 1\n"} else {print "not ok 1\n"} ($b_bin, $pest) = Rmpfr_init_set_str($bin, 0, GMP_RNDN); if($b_bin == $bin && $b_bin == $dec && $b_bin == '703710') {print "ok 2\n"} else {print "not ok 2\n"} $b_hex2 = Rmpfr_init(); $b_bin2 = Rmpfr_init(); $b_dec2 = Rmpfr_init(); Rmpfr_set_str($b_hex2, $hex, 0, GMP_RNDN); if($b_hex2 == $hex && $b_hex2 == $dec && $b_hex2 == '703710') {print "ok 3\n"} else {print "not ok 3\n"} Rmpfr_set_str($b_bin2, $bin, 0, GMP_RNDN); if($b_bin2 == $bin && $b_bin2 == $dec && $b_bin2 == '703710') {print "ok 4\n"} else {print "not ok 4\n"} ($b_dec, $pest) = Rmpfr_init_set_str($dec_str, 0, GMP_RNDN); if($b_dec == $hex && $b_dec == $dec && $b_dec == '703710') {print "ok 5\n"} else {print "not ok 5\n"} Rmpfr_set_str($b_dec2, $dec_str, 0, GMP_RNDN); if($b_dec2 == $bin && $b_dec2 == $dec && $b_dec2 == '703710') {print "ok 6\n"} else {print "not ok 6\n"} ($two, $pest) = Rmpfr_init_set_str('2', 0, GMP_RNDN); my $ok = ''; $two = $two * $hex; if($two == 1407420) {$ok = 'a'} $two = $two / $hex; if($two == 2) {$ok .= 'b'} $two = $two + $bin; if($two == $dec + 2) {$ok .= 'c'} $two = $two - $bin; if($two == 2) {$ok .= 'd'} $rev = $hex * $two; if($rev == 1407420) {$ok .= 'e'} $rev = $hex / $two; if($rev == 351855) {$ok .= 'f'} $rev = $bin + $two; if($rev == $dec + 2) {$ok .= 'g'} $rev = $bin - $two; if($rev == 703708) {$ok .= 'h'} if($ok eq 'abcdefgh') {print "ok 7\n"} else {print "not ok 7 $ok\n"} $ok = ''; $two *= $hex; if($two == 1407420) {$ok = 'a'} $two /= $hex; if($two == 2) {$ok .= 'b'} $two += $bin; if($two == $dec + 2) {$ok .= 'c'} $two -= $bin; if($two == 2) {$ok .= 'd'} if($two < '0b11') {$ok .= 'e'} if($two > '0x1') {$ok .= 'f'} if($two <= '0b10') {$ok .= 'g'} if($two >= '0x2') {$ok .= 'h'} if($two != '0b11111') {$ok .= 'i'} if(!($two <=> '0x2')) {$ok .= 'j'} if($ok eq 'abcdefghij') {print "ok 8\n"} else {print "not ok 8 $ok\n"} $rev = $two ** '0b11'; if($rev == '0b1000') {print "ok 9\n"} else {print "not ok 9 $rev\n"} $two **= '0x3'; if($two == 8) {print "ok 10\n"} else {print "not ok 10 $two\n"} $two **= 2; $two **= '0b1.0e-1'; # Take square root if($two == 8) {print "ok 11\n"} else {print "not ok 11\n"} Rmpfr_set_str($b_hex, '.12345@-11', 10, GMP_RNDN); Rmpfr_set_str($b_bin, ".12345\@-11", 0, GMP_RNDN); if($b_hex == $b_bin) {print "ok 12\n"} else {print "not ok 12\n"} Rmpfr_set_str($two, '2', 0, GMP_RNDN); $rev = '0b1e-1' ** $two; if($rev == '0.25') {print "ok 13\n"} else {print "not ok 13\n"} Rmpfr_set_default_prec(300); $z = Rmpfr_init(); my $bigstr = '0b'. ('1' x 250); Rmpfr_set_str($z, $bigstr, 0, GMP_RNDN); if($z == $bigstr) {print "ok 14\n"} else {print "not ok 14\n"} $ok = ''; my $ret = Rmpfr_strtofr($z, '11111111111.11111111111111', 0, GMP_RNDD); if($ret == -1) {$ok = 'a'} $ret = Rmpfr_strtofr($z, '11111111111.11111111111111', 0, GMP_RNDU); if($ret == 1) {$ok .= 'b'} $ret = Rmpfr_strtofr($z, '-11111111111.11111111111111', 0, GMP_RNDZ); if($ret == 1) {$ok .= 'c'} $ret = Rmpfr_strtofr($z, '11111111111.11111111111111', 0, GMP_RNDZ); if($ret == -1) {$ok .= 'd'} $ret = Rmpfr_strtofr($z, '-11111111111.5s11111111111111', 0, GMP_RNDD); if(!$ret) {$ok .= 'e'} $ret = Rmpfr_strtofr($z, '-11111111111.5s11111111111111', 0, GMP_RNDU); if(!$ret) {$ok .= 'f'} $ret = Rmpfr_strtofr($z, 'm11111111111.5s11111111111111', 0, GMP_RNDD); if(!$z) {$ok .= 'g'} $ret = Rmpfr_strtofr($z, 'm11111111111.5s11111111111111', 0, GMP_RNDU); if(!$z) {$ok .= 'h'} eval {$ret = Rmpfr_strtofr($z, '11111111111.11111111111111', 60, GMP_RNDD);}; if(MPFR_VERSION_MAJOR >= 3) { unless($@) {$ok .= 'i'} else {warn "15i: \$\@: $@\n"} } else { if($@ =~ /3rd argument supplied to Rmpfr_strtofr/) {$ok .= 'i'} else {warn "15i: \$\@: $@\n"} } if($ok eq 'abcdefghi') {print "ok 15\n"} else {print "not ok 15 $ok\n"} Math-MPFR-3.32/t/sign.t0000644000076400010400000000205312660557734016153 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print "1..1\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(150); my $nan = Math::MPFR->new(); my $inf = Math::MPFR->new(); my $neg = Math::MPFR->new(-12345); my $pos = Math::MPFR->new(23456); my $ok = ''; $ok .= 'a' if !Rmpfr_signbit($nan); $ok .= 'b' if Rmpfr_signbit($neg); $ok .= 'c' if !Rmpfr_signbit($pos); Rmpfr_set_si($nan, -2, GMP_RNDN); Rmpfr_setsign($nan, $neg, 0, GMP_RNDN); $ok .= 'd' if $nan + $neg == 0; Rmpfr_setsign($nan, $neg, -1, GMP_RNDN); $ok .= 'e' if $nan == $neg; Rmpfr_setsign($nan, $neg, 1, GMP_RNDN); $ok .= 'f' if $nan == $neg; Rmpfr_copysign($nan, $pos, $neg, GMP_RNDN); $ok .= 'g' if $nan + $pos == 0; Rmpfr_set_inf($inf, 1); $ok .= 'h' if !Rmpfr_signbit($inf); Rmpfr_set_inf($inf, -1); $ok .= 'i' if Rmpfr_signbit($inf); if($ok eq 'abcdefghi') {print "ok 1\n"} else {print "not ok $ok\n"} Math-MPFR-3.32/t/sizes.t0000644000076400010400000000141512660557734016351 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR; use Config; print "1..4\n"; my @sizes = Math::MPFR::_mp_sizes(); if(@sizes == 3) {print "ok 1\n"} else { warn "scalar(\@sizes): ", scalar(@sizes), "\n"; print "not ok 1\n"; } if(Math::MPFR::_ivsize() == $Config::Config{ivsize}) {print "ok 2\n"} else { warn "Math::MPFR::_ivsize(): ", Math::MPFR::_ivsize(), "\n\$Config{ivsize}: $Config::Config{ivsize}\n"; print "not ok 2\n"; } if(Math::MPFR::_nvsize() == $Config::Config{nvsize}) {print "ok 3\n"} else { warn "Math::MPFR::_nvsize(): ", Math::MPFR::_nvsize(), "\n\$Config{nvsize}: $Config::Config{nvsize}\n"; print "not ok 3\n"; } my $ok = 1; for(@sizes) { unless($_ >= 4 && $_ <= Math::MPFR::_ivsize()) {$ok = 0} } if($ok) {print "ok 4\n"} else {print "not ok 4\n"} Math-MPFR-3.32/t/sum.t0000644000076400010400000000174112660557734016022 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); print"1..3\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my ($sum, @obj); my $rop = Math::MPFR->new(); for(my $i = int(rand(201)); $i < 10000; $i++) { push @obj, Math::MPFR->new($i); $sum += $i; } my $ret = Rmpfr_sum($rop, \@obj, scalar(@obj), GMP_RNDN); if($sum == $rop) {print "ok 1\n"} else { warn "\n Got $rop\n Expected $sum\n"; print "not ok 1\n"; } Rmpfr_add_si($rop, $rop, -1, GMP_RNDN); if($rop == $sum - 1) {print "ok 2\n"} else { warn "\n Got $rop\n Expected ", $sum - 1, "\n"; print "not ok 2\n"; } my $size = @obj + 1; my $max = $size - 1; eval {Rmpfr_sum($rop, \@obj, $size, GMP_RNDN)}; if($@ =~ /2nd last arg \($size\) needs to be between 0 and $max \(inclusive\)/) {print "ok 3\n"} else { warn "\n\$\@: $@\n"; print "not ok 3\n"; } Math-MPFR-3.32/t/test1.t0000644000076400010400000006377412660557734016274 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); use Config; $| = 1; print "1..85\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $double = 12345.5; my $ui = 4; my $si = -1369012; my ($ok, $exp); my($have_mpz, $have_mpf, $have_mpq, $have_Math_GMP) = (0, 0, 0, 0); eval{require Math::GMPz}; if(!$@) {$have_mpz = 1} eval{require Math::GMPf}; if(!$@) {$have_mpf = 1} eval{require Math::GMPq}; if(!$@) {$have_mpq = 1} eval{require Math::GMP}; if(!$@) {$have_Math_GMP = 1} my($z, $f, $q, $qq); if($have_mpz) {$z = Math::GMPz::Rmpz_init_set_str('aaaaaaaaaaaaaaaaaaaa', 36)} if($have_mpq) { $q = Math::GMPq::Rmpq_init(); Math::GMPq::Rmpq_set_str($q, 'qqqqqqqqqqqqqq/12345z', 36); Math::GMPq::Rmpq_canonicalize($q); } if($have_mpf) {$f = Math::GMPf::Rmpf_init_set_str('zzzzzzzzzzzzz123@-5', 36)} if(Rmpfr_get_default_prec() == 53) {print "ok 1\n"} else {print "not ok 1\n"} Rmpfr_set_default_prec(101); if(Rmpfr_get_default_prec() == 101) {print "ok 2\n"} else {print "not ok 2\n"} if(MPFR_VERSION_MAJOR >= 3) { if(Rmpfr_min_prec(Math::MPFR->new(0)) == 0) {$ok = 'a'} else {warn "3a: ", Rmpfr_min_prec(Math::MPFR->new(0)), "\n"} if(Rmpfr_min_prec(Math::MPFR->new(31)) == 5) {$ok .= 'b'} else {warn "3b: ", Rmpfr_min_prec(Math::MPFR->new(31)), "\n"} } else { eval{Rmpfr_min_prec(Math::MPFR->new(0));}; if($@ =~ /not implemented for/) {$ok = 'a'} else {warn "3a: ", $@ ? $@ : "\$\@ unexpectedly not set"} eval{Rmpfr_min_prec(Math::MPFR->new(31));}; if($@ =~ /not implemented for/) {$ok .= 'b'} else {warn "3b: ", $@ ? $@ : "\$\@ unexpectedly not set"} } if(RMPFR_PREC_MAX > RMPFR_PREC_MIN) {$ok .= 'c'} else {warn "RMPFR_PREC_MAX: ", RMPFR_PREC_MAX, "\nRMPFR_PREC_MIN: ", RMPFR_PREC_MIN, "\n"} if($ok eq 'abc') {print "ok 3\n"} else { warn "\$ok: $ok\n"; print "not ok 3\n"; } $ok = ''; my $c = Rmpfr_init(); my $c_ui = Rmpfr_init(); my $d = Rmpfr_init2(300); my $e = Rmpfr_init2(300); my $check = Rmpfr_init2(300); my $check2 = Rmpfr_init2(300); my $check3 = Rmpfr_init2(300); #my $check4 = Rmpfr_init2(300); my $angle = Rmpfr_init2(300); my $unity = Rmpfr_init2(300); my $s = Rmpfr_init2(300); my $t = Rmpfr_init2(300); my $log1 = Rmpfr_init2(200); my $log2 = Rmpfr_init2(150); Rmpfr_set_d($angle, 3.217, GMP_RNDN); Rmpfr_set_ui($unity, 1, GMP_RNDN); #print Rmpfr_get_prec($c), "\n"; if(Rmpfr_get_prec($c) >= 101 && Rmpfr_get_prec($c) < 300 && Rmpfr_get_prec($d) >= 300) {print "ok 4\n"} else {print "not ok 4\n"} Rmpfr_set_prec($c, 300); if(Rmpfr_get_prec($c) == 300) {print "ok 5\n"} else {print "not ok 5\n"} Rmpfr_set_str($c, 'afsder.dgk1111111111111111111116', 36, GMP_RNDZ); my $s3 = Rmpfr_get_str($c, 16, 75, GMP_RNDU); my $s4 = Rmpfr_get_str($c, 16, 75, GMP_RNDD); if($s3 ne $s4) {print "ok 6\n"} else {print "not ok 6 $s3 $s4\n"} Rmpfr_set($d, $c, GMP_RNDD); $s3 = Rmpfr_get_str($d, 16, 75, GMP_RNDU); $s4 = Rmpfr_get_str($d, 16, 75, GMP_RNDD); if($s3 ne $s4) {print "ok 7\n"} else {print "not ok 7 $s3 $s4\n"} Rmpfr_set_d($c, $double, GMP_RNDN); if(Rmpfr_get_d($c, GMP_RNDN) == $double) {print "ok 8\n"} else {print "not ok 8\n"} if(Rmpfr_get_d1($c) == $double) {print "ok 9\n"} else {print "not ok 9\n"} if($have_mpz) { Rmpfr_set_z($c, $z, GMP_RNDN); if(Rmpfr_get_str($c, 36, 20, GMP_RNDN) eq 'a.aaaaaaaaaaaaaaaaaaa@19') {print "ok 10\n"} else {print "not ok 10 ", Rmpfr_get_str($c, 36, 20, GMP_RNDN), "\n"} } else { warn "Skipping test 10 - no Math::GMPz\n"; print "ok 10\n"; } Rmpfr_set_prec($c, 53); Rmpfr_set_ui($c, 2, GMP_RNDN); if($have_mpz) { my $exp = Rmpfr_get_z_exp($z, $c); if($exp == -51 && Math::GMPz::Rmpz_get_str($z, 10) eq '4503599627370496') {print "ok 11\n"} else {print "not ok 11\n"} } else { warn "Skipping test 11 - no Math::GMPz\n"; print "ok 11\n"; } Rmpfr_set_prec($c, 300); Rmpfr_set_str($c, 'zyxwvp123456@-2', 36, GMP_RNDN); Rmpfr_set($check, $c, GMP_RNDN); Rmpfr_add($c, $c, $d, GMP_RNDN); Rmpfr_add_ui($c, $c, 12345, GMP_RNDN); Rmpfr_sub($c, $c, $d, GMP_RNDN); Rmpfr_sub_ui($c, $c, 12345, GMP_RNDN); if(Rmpfr_eq($c, $check, 250)) {print "ok 12\n"} else {print "not ok 12\n"} Rmpfr_ui_sub($check, 0, $c, GMP_RNDN); Rmpfr_neg($c, $c, GMP_RNDN); if(!Rmpfr_cmp($c, $check)) {print "ok 13\n"} else {print "not ok 13\n"} Rmpfr_add($check, $c, $c, GMP_RNDN); Rmpfr_mul_ui($check2, $c, 2, GMP_RNDN); Rmpfr_mul_2exp($check3, $c, 1, GMP_RNDN); if(!Rmpfr_cmp($check, $check2) && !Rmpfr_cmp($check, $check3)) {print "ok 14\n"} else {print "not ok 14\n"} Rmpfr_div_ui($check2, $check, 2, GMP_RNDN); Rmpfr_div_2exp($check3, $check, 1, GMP_RNDN); Rmpfr_mul_2ui($check3, $check3, 3, GMP_RNDN); Rmpfr_mul_2si($check3, $check3, -3, GMP_RNDN); Rmpfr_div_2ui($check3, $check3, 3, GMP_RNDN); Rmpfr_div_2si($check3, $check3, -3, GMP_RNDN); if(!Rmpfr_cmp($check2, $check3)) {print "ok 15\n"} else {print "not ok 15\n"} Rmpfr_div($check, $c, $c, GMP_RNDN); if(!Rmpfr_cmp_ui($check, 1)) {print "ok 16\n"} else {print "not ok 16\n"} Rmpfr_ui_div($check, 1, $c, GMP_RNDN); Rmpfr_mul($check, $c, $check, GMP_RNDN); if(!Rmpfr_cmp_ui($check, 1)) {print "ok 17\n"} else {print "not ok 17\n"} Rmpfr_pow_ui($check2, $c, 2, GMP_RNDN); Rmpfr_sqrt($check2, $check2, GMP_RNDN); if(Rmpfr_cmp($check2, $c) && !Rmpfr_eq($check2, $c, 10)) {print "ok 18\n"} else {print "not ok 18\n"} Rmpfr_abs($c, $c, GMP_RNDN); if(Rmpfr_eq($check2, $c, 280)) {print "ok 19\n"} else {print "not ok 19\n"} if(Rmpfr_nan_p($e) && Rmpfr_number_p($c) && Rmpfr_sgn($c) == 1) {print "ok 20\n"} else {print "not ok 20\n"} Rmpfr_div_ui($check2, $c, 0, GMP_RNDN); if(Rmpfr_inf_p($check2)) {print "ok 21\n"} else {print "not ok 21\n"} Rmpfr_neg($check2, $c, GMP_RNDN); Rmpfr_reldiff($check, $check2, $c, GMP_RNDN); if(!Rmpfr_cmp_si($check, -2)) {print "ok 22\n"} else {print "not ok 22\n"} if($have_mpz) { Rmpfr_div_z($check2, $c, $z, GMP_RNDN); Rmpfr_mul_z($check2, $check2, $z, GMP_RNDN); if(Rmpfr_eq($check2, $c, 280)) {print "ok 23\n"} else {print "not ok 23\n"} } else { warn "Skipping test 23 - no Math::GMPz\n"; print "ok 23\n"; } if($have_mpq) { Rmpfr_div_q($check2, $c, $q, GMP_RNDN); Rmpfr_mul_q($check2, $check2, $q, GMP_RNDN); if(Rmpfr_eq($check2, $c, 280)) {print "ok 24\n"} else {print "not ok 24\n"} } else { warn "Skipping test 24 - no Math::GMPq\n"; print "ok 24\n"; } Rmpfr_neg($check, $c, GMP_RNDN); Rmpfr_set($check2, $c, GMP_RNDN); Rmpfr_swap($check2, $check); Rmpfr_add($check3, $check2, $check, GMP_RNDN); if(Rmpfr_sgn($check2) == -1 && Rmpfr_sgn($check) == 1 && !Rmpfr_cmp_ui($check3, 0)) {print "ok 25\n"} else {print "not ok 25\n"} Rmpfr_sin_cos($s, $c, $angle, GMP_RNDN); Rmpfr_pow_ui($check, $s, 2, GMP_RNDN); Rmpfr_pow_ui($check2, $c, 2, GMP_RNDN); Rmpfr_add($check3, $check2, $check, GMP_RNDN); if(Rmpfr_eq($check3, $unity, 280)) {print "ok 26\n"} else {print "not ok 26\n"} Rmpfr_tan($t, $angle, GMP_RNDN); Rmpfr_div($check, $s, $c, GMP_RNDN); if(Rmpfr_eq($t, $check, 280)) {print "ok 27\n"} else {print "not ok 27\n"} my $d2; Rmpfr_const_pi($c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 3.14159265 && $d2 < 3.14159266) {print "ok 28\n"} else {print "not ok 28\n"} Rmpfr_const_euler($c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 0.5772156649 && $d2 < 0.577215665) {print "ok 29\n"} else {print "not ok 29\n"} Rmpfr_const_log2($c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 0.69314718 && $d2 < 0.69314719) {print "ok 30\n"} else {print "not ok 30\n"} my $ret = Rmpfr_exp($c, $unity, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($ret && $d2 > 2.7182818284 && $d2 < 2.7182818285) {print "ok 31\n"} else {print "not ok 31\n"} Rmpfr_set_d($c, $d2, GMP_RNDN); Rmpfr_log($c, $c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 0.99999 && $d2 < 1.00001) {print "ok 32\n"} else {print "not ok 32\n"} Rmpfr_set_d($c, $double, GMP_RNDN); Rmpfr_exp2($c, $c, GMP_RNDN); Rmpfr_log2($c, $c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 12345.49 && $d2 < 12345.51) {print "ok 33\n"} else {print "not ok 33\n"} Rmpfr_set_d($c, 3.6, GMP_RNDN); Rmpfr_exp10($c, $c, GMP_RNDN); Rmpfr_log10($c, $c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 3.59 && $d2 < 3.61) {print "ok 34\n"} else {print "not ok 34\n"} Rmpfr_set_d($c, $double, GMP_RNDN); Rmpfr_set_ui($d, 10, GMP_RNDN); Rmpfr_pow($c, $d, $c, GMP_RNDN); Rmpfr_log10($c, $c, GMP_RNDN); $d2 = Rmpfr_get_d($c, GMP_RNDN); if($d2 > 12345.49 && $d2 < 12345.51) {print "ok 35\n"} else {print "not ok 35\n"} Rmpfr_set_ui($check2, 12345, GMP_RNDN); Rmpfr_set_ui($check3, 12346, GMP_RNDN); Rmpfr_agm($check, $check3, $check2, GMP_RNDN); $d2 = Rmpfr_get_d($check, GMP_RNDN); if($d2 > 12345.49999 && $d2 < 12345.50001) {print "ok 36\n"} else {print "not ok 36\n"} $ret = ''; Rmpfr_set_d($d, 123456.6, GMP_RNDN); Rmpfr_rint($c, $d, GMP_RNDD); if(!Rmpfr_cmp_ui($c, 123456)) { $ret .= 'a'} Rmpfr_ceil($c, $d); if(!Rmpfr_cmp_ui($c, 123457)) { $ret .= 'b'} Rmpfr_floor($c, $d); if(!Rmpfr_cmp_ui($c, 123456)) { $ret .= 'c'} Rmpfr_round($c, $d); if(!Rmpfr_cmp_ui($c, 123457)) { $ret .= 'd'} Rmpfr_trunc($c, $d); if(!Rmpfr_cmp_ui($c, 123456)) { $ret .= 'e'} if($ret eq 'abcde') {print "ok 37\n"} else {print "not ok 37 $ret\n"} if(Rmpfr_get_emin() < -1000000 && Rmpfr_get_emax > 1000000) {print "ok 38\n"} else {print "not ok 38\n"} if(!Rmpfr_check_range($d, 0, GMP_RNDN)) {print "ok 39\n"} else {print "not ok 39\n"} if($have_mpf) { Rmpfr_set_f($c, $f, GMP_RNDN); Rmpfr_set_str($d, 'zzzzzzzzzzzzz123@-5', 36, GMP_RNDN); if(Rmpfr_eq($c, $d, 100)) {print "ok 40\n"} else {print "not ok 40\n"} } else { warn "Skipping test 40 - no Math::GMPf\n"; print "ok 40\n"; } my @r = (); Rmpfr_set_default_prec(75); for(1..100) {push @r, Rmpfr_init()} if($have_mpz) { my $str = '1'; for(1..63) {$str .= int(rand(2))} my $seed = Math::GMPz::Rmpz_init_set_str($str, 2); my $state = Rmpfr_randinit_default(); Rmpfr_randseed($state, $seed); $ok = 1; Rmpfr_urandomb(@r, $state); for(@r) { if(length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) > 80 || length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) < 40) {$ok = 0} if($_ <= 0 || $_ >= 1) {$ok = 0} } for(my $i = 0; $i < 100; $i++) { for(my $j = $i + 1; $j < 100; $j++) { if($r[$i] == $r[$j]) {$ok = 0} } } if($ok) {print "ok 41\n"} else {print "not ok 41\n"} Rmpfr_randclear($state); } else { warn "Skipping test 41 - no Math::GMPz\n"; print "ok 41\n"; } { my $str = ''; for(1..21) {$str .= 1 + int(rand(9))} my $state = Rmpfr_randinit_lc_2exp_size(100); Rmpfr_randseed($state, $str); my $ok = 1; Rmpfr_urandomb(@r, $state); for(@r) { if(length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) > 80 || length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) < 40) {$ok = 0} if($_ <= 0 || $_ >= 1) {$ok = 0} } for(my $i = 0; $i < 100; $i++) { for(my $j = $i + 1; $j < 100; $j++) { if($r[$i] == $r[$j]) {$ok = 0} } } if($ok) {print "ok 42\n"} else {print "not ok 42\n"} Rmpfr_randclear($state); } my $o = Rmpfr_init(); Rmpfr_set_d($o, $double, GMP_RNDN); my ($t1, $s1) = Rmpfr_init_set($o, GMP_RNDN); my ($t2, $s2) = Rmpfr_init_set_d($double, GMP_RNDN); if(Rmpfr_eq($t1, $t2, 50)) {print "ok 43\n"} else {print "not ok 43\n"} my ($t3, $s33) = Rmpfr_init_set_ui(int($double), GMP_RNDN); my ($t4, $s44) = Rmpfr_init_set_si(int($double) + 1, GMP_RNDN); if(Rmpfr_cmp($t3, $t2) < 0 && Rmpfr_cmp($t4, $t2) > 0 && Rmpfr_get_prec($t3) == Rmpfr_get_default_prec()) {print "ok 44\n"} else {print "not ok 44\n"} if($have_mpz) { eval {my $t = Rmpfr_init_set_z($z, GMP_RNDN)}; if(!$@) {print "ok 45\n"} else {print "not ok 45\n"} } else { warn "Skipping test 45 - no Math::GMPz\n"; print "ok 45\n"; } if($have_mpq) { eval {my $t = Rmpfr_init_set_q($q, GMP_RNDN)}; if(!$@) {print "ok 46\n"} else {print "not ok 46\n"} } else { warn "Skipping test 46 - no Math::GMPq\n"; print "ok 46\n"; } if($have_mpf) { eval {my $t = Rmpfr_init_set_f($f, GMP_RNDN)}; if(!$@) {print "ok 47\n"} else {print "not ok 47\n"} } else { warn "Skipping test 47 - no Math::GMPf\n"; print "ok 47\n"; } if($have_mpz) { # Check that a specific MPFR bug has been fixed Rmpfr_clear_nanflag(); Math::GMPz::Rmpz_set_ui($z, 0); Rmpfr_set($check, $c, GMP_RNDN); my $ok = ''; Rmpfr_add_z($c, $c, $z, GMP_RNDN); if($c == $check) {$ok = 'a'} Rmpfr_sub_z($c, $c, $z, GMP_RNDN); if($c == $check) {$ok .= 'b'} Rmpfr_mul_z($check, $c, $z, GMP_RNDN); if($check == 0) {$ok .= 'c'} my $flag = Rmpfr_nanflag_p(); Rmpfr_div_z($check, $c, $z, GMP_RNDN); if(Rmpfr_inf_p($check)) {$ok .= 'd'} if($ok eq 'abcd' && !$flag && Math::MPFR::get_refcnt($c) == 1 && Math::MPFR::get_refcnt($check) == 1){print "ok 48\n"} else {print "not ok 48 \$ok: $ok \$flag: $flag\n"} } else { warn "Skipping test 48 - no Math::GMPz\n"; print "ok 48\n"; } $ok = ''; $check = $c; $c *= 0; if($check != $c) {$ok = 'a'} $check *= 0; if($check == $c) {$ok .= 'b'} Rmpfr_clear_nanflag(); my $flag = Rmpfr_nanflag_p(); $check = $check / $c; if(!$flag && Rmpfr_nanflag_p() && Math::MPFR::get_refcnt($check) == 1 && Math::MPFR::get_refcnt($c) == 1 && $ok eq 'ab') {print "ok 49\n"} else {print "not ok 49 (Got: $flag ", Rmpfr_nanflag_p(), " $ok)\n"} ######################## ############################################### my $inf = Rmpfr_init(); Rmpfr_set_inf($inf, -1); if(Rmpfr_inf_p($inf)) {print "ok 50\n"} else {print "not ok 50\n"} my $nan = Rmpfr_init(); Rmpfr_set_nan($nan); if(Rmpfr_nan_p($nan)) {print "ok 51\n"} else {print "not ok 51\n"} Rmpfr_set_si($inf, -27, GMP_RNDN); Rmpfr_cbrt($inf, $inf, GMP_RNDN); if($inf == -3 && Rmpfr_integer_p($inf)) {print "ok 52\n"} else {print "not ok 52\n"} $ok = 1; my @r3 = (); Rmpfr_set_default_prec(75); for(1..100) {push @r3, Rmpfr_init()} if(!(MPFR_VERSION_MAJOR > 2)) { for(@r3) {Rmpfr_random2($_, 6, 2)} my $dup_count = 0; for(my $i = 0; $i < 100; $i++) { for(my $j = $i + 1; $j < 100; $j++) { if($r3[$i] == $r3[$j]) {$dup_count ++} } } if($dup_count < 6) {print "ok 53\n"} else {print "not ok 53\n"} } else { warn "Skipping test 53: Rmpfr_random2 no longer implemented\n"; print "ok 53\n"; } Rmpfr_set_si($c, -123, GMP_RNDN); Rmpfr_set_si($check, -7, GMP_RNDN); if(Rmpfr_cmpabs($c, $check) > 0 && !Rmpfr_unordered_p($c, $check)) {print "ok 54\n"} else {print "not ok 54\n"} $ok = ''; Rmpfr_min($check2, $check, $c, GMP_RNDN); if($check2 == $c) {$ok = 'a'} Rmpfr_max($check2, $check, $c, GMP_RNDN); if($check2 == $check) {$ok .= 'b'} if($ok eq 'ab') {print "ok 55\n"} else {print "not ok 55 $ok\n"} my $log3 = Rmpfr_init2(200); my $signp; Rmpfr_set_d($c, 1.003, GMP_RNDN); Rmpfr_lngamma($log2, $c, GMP_RNDN); ($signp, $ret) = Rmpfr_lgamma($log3, $c, GMP_RNDN); Rmpfr_gamma($c, $c, GMP_RNDN); Rmpfr_log($log1, $c, GMP_RNDN); if($c > 0.9982772 && $c < 0.9982773){print "ok 56\n"} else {print "not ok 56\n"} $ok = ''; if($log1 - $log3 < 0.000000001 && $log1 - $log3> -0.000000001){$ok .= 'a'} if($signp == 1) {$ok .= 'b'} if($log1 - $log2 < 0.000000001 && $log1 - $log2 > -0.000000001){$ok .= 'c'} if($ok eq 'abc'){print "ok 57\n"} else {print "not ok 57 $ok\n"} Rmpfr_set_ui($c, 0, GMP_RNDN); Rmpfr_erf($check, $c, GMP_RNDN); if($check == 0) {print "ok 58\n"} else {print "not ok 58\n"} Rmpfr_const_pi($check, GMP_RNDN); $check **= 4; $check /= 90; Rmpfr_set_ui($c, 4, GMP_RNDN); Rmpfr_zeta($c, $c, GMP_RNDN); Rmpfr_zeta_ui($c_ui, 4, GMP_RNDN); $ok = ''; if($c > $check - 0.00001 && $c < $check + 0.00001) {$ok .= 'a'} else {warn "59 a: $c\n$check\n"} if($c_ui > $check - 0.00001 && $c_ui < $check + 0.00001) {$ok .= 'b'} else {warn "59 b: $c_ui\n$check\n"} if($ok eq 'ab') {print "ok 59\n"} else {print "not ok 59 $ok\n"} my $fail = Rmpfr_set_exp($c, -5); if(!$fail && Rmpfr_get_exp($c) == -5) {print "ok 60\n"} else {print "not ok 60\n"} if(1) { my $str = ''; for(1..21) {$str .= 1 + int(rand(10))} my $state = Rmpfr_randinit_lc_2exp_size(90); Rmpfr_randseed($state, $str); my $ok = 1; Rmpfr_urandomb(@r, $state); for(@r) { if(length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) > 80 || length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) < 40) {$ok = 0} if($_ <= 0 || $_ >= 1) {$ok = 0} } for(my $i = 0; $i < 100; $i++) { for(my $j = $i + 1; $j < 100; $j++) { if($r[$i] == $r[$j]) {$ok = 0} } } if($ok) {print "ok 61\n"} else {print "not ok 61\n"} Rmpfr_randclear($state); } ########################################## if($have_mpz) { my $str = ''; for(1..21) {$str .= 1 + int(rand(9))} my $seed = Math::GMPz::Rmpz_init_set_str($str, 10); my $state = Rmpfr_randinit_lc_2exp_size(120); Rmpfr_randseed($state, $seed); my $ok = 1; Rmpfr_urandomb(@r, $state); for(@r) { if(length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) > 80 || length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) < 40) {$ok = 0} if($_ <= 0 || $_ >= 1) {$ok = 0} } for(my $i = 0; $i < 100; $i++) { for(my $j = $i + 1; $j < 100; $j++) { if($r[$i] == $r[$j]) {$ok = 0} } } if($ok) {print "ok 62\n"} else {print "not ok 62\n"} Rmpfr_randclear($state); } else { warn "Skipping test 62 - no Math::GMPz\n"; print "ok 62\n"; } ######################### if(1) { my $str = ''; for(1..21) {$str .= 1 + int(rand(10))} my $state = Rmpfr_randinit_lc_2exp_size(100); Rmpfr_randseed_ui($state, 1123456); my $ok = 1; Rmpfr_urandomb(@r, $state); for(@r) { if(length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) > 80 || length(Rmpfr_get_str($_, 2, 0, GMP_RNDN)) < 40) {$ok = 0} if($_ <= 0 || $_ >= 1) {$ok = 0} } for(my $i = 0; $i < 100; $i++) { for(my $j = $i + 1; $j < 100; $j++) { if($r[$i] == $r[$j]) {$ok = 0} } } if($ok) {print "ok 63\n"} else {print "not ok 63\n"} Rmpfr_randclear($state); } Rmpfr_set_d($c, 1123.5, GMP_RNDN); eval {Rmpfr_out_str($c, 10, 0, GMP_RNDN); print "\n";}; if($@) {print "not ok 64\n"} else {print "ok 64\n"} eval {Rmpfr_print_binary($c); print "\n";}; if($@) {print "ok 65\n"} else {print "not ok 65\n"} eval {Rmpfr_dump($c);}; if($@) {print "not ok 66\n"} else {print "ok 66\n"} eval{$ok = Math::MPFR::gmp_v();}; if($@ || $ok =~ /[^0-9\.]/) {print "not ok 67\n"} else {print "ok 67\n"} Rmpfr_const_catalan($c, GMP_RNDN); if($c - 0.915965594177 < 0.0000000001 && $c - 0.915965594177 > - 0.0000000001) {print "ok 68\n"} else {print "not ok 68\n"} Rmpfr_set_si($c, -3, GMP_RNDN); Rmpfr_lngamma($c, $c, GMP_RNDN); if(Rmpfr_inf_p($c)) {print "ok 69\n"} else { warn "lngamma(-3): $c\n"; print "not ok 69\n"; } Rmpfr_erf($s, $log1, GMP_RNDN); Rmpfr_erfc($t, $log1, GMP_RNDN); # erfc(x) = 1 - erf(x) if($s + $t < 1.00000000001 && $s + $t > 0.99999999999) {print "ok 70\n"} else {print "not ok 70\n"} Rmpfr_set_d($s, 175.92186044416, GMP_RNDN); Rmpfr_root($s, $s, 11, GMP_RNDN); if($s - 1.6 < 0.0000000001 && $s - 1.6 > -0.0000000001) {print "ok 71\n"} else {print "not ok 71\n"} Rmpfr_set_si($s, -2, GMP_RNDN); Rmpfr_eint($s, $s, GMP_RNDN); if(Rmpfr_nan_p($s)) {print "ok 72\n"} else {print "not ok 72\n"} Rmpfr_set_default_prec(300); if($have_mpz) { my $zzz = Math::GMPz::Rmpz_init_set_ui(60); Rmpfr_set_ui($s, 3, GMP_RNDN); Rmpfr_pow_z($s, $s, $zzz, GMP_RNDN); if($s == '42391158275216203514294433201') {print "ok 73\n"} else {print "not ok 73\n"} } else { warn "Skipping test 73 - no Math::GMPz\n"; print "ok 73\n"; } if($have_Math_GMP) { my $zzz = Math::GMP->new(60); Rmpfr_set_ui($s, 3, GMP_RNDN); Rmpfr_pow_z($s, $s, $zzz, GMP_RNDN); if($s == '42391158275216203514294433201') {print "ok 74\n"} else {print "not ok 74\n"} } else { warn "Skipping test 74 - no Math::GMP\n"; print "ok 74\n"; } if($have_mpf) { my $f1 = Math::GMPf::Rmpf_init(); Rmpfr_set_d($s, 23.625, GMP_RNDN); Rmpfr_get_f($f1, $s, GMP_RNDN); if(Rmpfr_cmp_f($s, $f1)) {print "not ok 75\n"} else {print "ok 75\n"} } else { warn "Skipping test 75 - no Math::GMPf\n"; print "ok 75\n"; } Rmpfr_set_d($s, 12345.5, GMP_RNDN); if(Rmpfr_cmp_d($s, 12345.5)) {print "not ok 76\n"} else {print "ok 76\n"} if($s == 12345.5 && $s <= 12345.5 && $s >= 12345.5 && ($s <=> 12345.6) < 0 && ($s <=> 12345.5) == 0 && ($s <=> 12345.4) > 0 && $s != 12345.4 && $s > 12345.4 && $s >= 12345.4 && $s < 12345.6 && $s <= 12345.6) {print "ok 77\n"} else {print "not ok 77\n"} my $hypot1 = Math::MPFR->new(5); my $hypot2 = Math::MPFR->new(12); Rmpfr_hypot($s, $hypot1, $hypot2, GMP_RNDN); if($s == 13) {print "ok 78\n"} else {print "not ok 78\n"} my $num1 = Math::MPFR->new(100); $double = Rmpfr_get_d_2exp($exp, $num1, GMP_RNDN); if($double > 0.781249 && $double < 0.781251 && $exp == 7) {print "ok 79\n"} else { warn "\n Got (double): $double\n Expected: 0.78125\n\n", " Got (exp): $exp\n Expected: 7\n"; print "not ok 79\n"; } my $posinf = Math::MPFR->new('inf'); my $neginf = Math::MPFR->new('-inf'); $ok = ''; if($posinf == - $neginf) {$ok .= 'a'} else {warn "a: $posinf ", $neginf * -1, "\n"} $double = Rmpfr_get_d($nan, GMP_RNDN); Rmpfr_set_d($nan, $double, GMP_RNDN); if(Rmpfr_nan_p($nan)) {$ok .= 'b'} else {warn "b: $nan\n"} $double = Rmpfr_get_d($posinf, GMP_RNDN); Rmpfr_set_d($posinf, $double, GMP_RNDN); if(Rmpfr_inf_p($posinf) && $posinf > 0) {$ok .= 'c'} else {warn "c: $posinf\n"} $double = Rmpfr_get_d($neginf, GMP_RNDN); Rmpfr_set_d($neginf, $double, GMP_RNDN); if(Rmpfr_inf_p($neginf) && $neginf < 0) {$ok .= 'd'} else {warn "d: $neginf\n"} $double = Rmpfr_get_NV($nan, GMP_RNDN); Rmpfr_set_d($nan, $double, GMP_RNDN); if(Rmpfr_nan_p($nan)) {$ok .= 'e'} else {warn "e: $nan\n"} $double = Rmpfr_get_NV($posinf, GMP_RNDN); Rmpfr_set_d($posinf, $double, GMP_RNDN); if(Rmpfr_inf_p($posinf) && $posinf > 0) {$ok .= 'f'} else {warn "f: $posinf\n"} $double = Rmpfr_get_NV($neginf, GMP_RNDN); Rmpfr_set_d($neginf, $double, GMP_RNDN); if(Rmpfr_inf_p($neginf) && $neginf < 0) {$ok .= 'g'} else {warn "g: $neginf\n"} if($ok eq 'abcdefg') {print "ok 80\n"} else {print "not ok 80 $ok\n"} $ok = ''; my $ac1 = Math::MPFR->new(12.25); Rmpfr_add_d($ac1, $ac1, 0.25, GMP_RNDN); if($ac1 == 12.50){$ok .= 'a'} else {warn "81 a: $ac1\n"} Rmpfr_sub_d($ac1, $ac1, 0.25, GMP_RNDN); if($ac1 == 12.25){$ok .= 'b'} else {warn "81 b: $ac1\n"} Rmpfr_d_sub($ac1, 24.5, $ac1, GMP_RNDN); if($ac1 == 12.25){$ok .= 'c'} else {warn "81 c: $ac1\n"} Rmpfr_mul_d($ac1, $ac1, 2.5, GMP_RNDN); if($ac1 == 30.625){$ok .= 'd'} else {warn "81 d: $ac1\n"} Rmpfr_div_d($ac1, $ac1, 2.5, GMP_RNDN); if($ac1 == 12.25){$ok .= 'e'} else {warn "81 e: $ac1\n"} Rmpfr_d_div($ac1, 24.5, $ac1, GMP_RNDN); if($ac1 == 2){$ok .= 'f'} else {warn "81 f: $ac1\n"} Rmpfr_set_d($ac1, 0.0625, GMP_RNDN); Rmpfr_rec_sqrt($ac1, $ac1, GMP_RNDN); if($ac1 == 4){$ok .= 'g'} else {warn "81 g: $ac1\n"} Rmpfr_set_ui($ac1, 0, GMP_RNDN); Rmpfr_rec_sqrt($ac1, $ac1, GMP_RNDN); if(Rmpfr_inf_p($ac1)){$ok .= 'h'} else {warn "81 h: $ac1\n"} Rmpfr_set_ui($ac1, 0, GMP_RNDN); Rmpfr_mul_d($ac1, $ac1, -1.0, GMP_RNDN); Rmpfr_rec_sqrt($ac1, $ac1, GMP_RNDN); if(Rmpfr_inf_p($ac1)){$ok .= 'i'} else {warn "81 i: $ac1\n"} my $ac2 = $ac1; $ac2 *= -1; Rmpfr_rec_sqrt($ac1, $ac1, GMP_RNDN); if($ac1 == 0){$ok .= 'j'} else {warn "81 j: $ac1\n"} Rmpfr_rec_sqrt($ac2, $ac2, GMP_RNDN); if(Rmpfr_nan_p($ac2)){$ok .= 'k'} else {warn "81 k: $ac2\n"} Rmpfr_set_d($ac1, 12.25, GMP_RNDN); Rmpfr_modf($ac1, $ac2, $ac1, GMP_RNDN); if($ac1 == 12) {$ok .= 'l'} else {warn "81 l: $ac1\n"} if($ac2 == 0.25) {$ok .= 'm'} else {warn "81 m: $ac2\n"} Rmpfr_set_ui($ac1, 0, GMP_RNDN); Rmpfr_li2($ac2, $ac1, GMP_RNDN); if(!$ac2) {$ok .= 'n'} else {warn "81 n: $ac2\n"} Rmpfr_set_ui($ac1, 1, GMP_RNDN); Rmpfr_li2($ac2, $ac1, GMP_RNDN); if($ac2 > 1.64493406 && $ac2 < 1.64493407) {$ok .= 'o'} else {warn "81 o: $ac2\n"} Rmpfr_set_ui($ac1, 2, GMP_RNDN); Rmpfr_li2($ac2, $ac1, GMP_RNDN); if($ac2 > 2.4674011002 && $ac2 < 2.4674011003) {$ok .= 'p'} else {warn "81 p: $ac2\n"} if($ok eq 'abcdefghijklmnop'){print "ok 81\n"} else {print "not ok 81 $ok\n"} if(MPFR_VERSION_MAJOR >= 3) { my $str = ''; for(1..21) {$str .= 1 + int(rand(10))} my $state = Rmpfr_randinit_lc_2exp_size(90); Rmpfr_randseed($state, $str); my $rand = Math::MPFR->new(); Rmpfr_urandom($rand, $state, MPFR_RNDN); if($rand < 1 && $rand > 0) {print "ok 82\n"} else { warn "82: \$rand: $rand\n"; print "not ok 82\n"; } } else { my $str = ''; for(1..21) {$str .= 1 + int(rand(10))} my $state = Rmpfr_randinit_lc_2exp_size(90); Rmpfr_randseed($state, $str); my $rand = Math::MPFR->new(); eval{Rmpfr_urandom($rand, $state, MPFR_RNDN);}; if($@ =~ /Rmpfr_urandom not implemented/) {print "ok 82\n"} else { warn "82: \$\@: $@\n"; print "not ok 82\n"; } } if($have_mpz) { my $z = Math::GMPz->new(5); my $fr = Math::MPFR->new(); if(MPFR_VERSION_MAJOR >= 3) { Rmpfr_set_z_2exp($fr, $z, -2, MPFR_RNDN); if($fr == 1.25) {print "ok 83\n"} else { warn "83: \$fr: $fr\n"; print "not ok 83\n"; } } else { eval{Rmpfr_set_z_2exp($fr, $z, -2, MPFR_RNDN);}; if($@ =~ /Rmpfr_set_z_2exp not implemented/) {print "ok 83\n"} else { warn "83: \$\@: $@\n"; print "not ok 83\n"; } } } else { warn "Skipping test 83: No Math::GMPz\n"; print "ok 83\n"; } if($have_Math_GMP) { my $z = Math::GMP->new(5); my $fr = Math::MPFR->new(); if(MPFR_VERSION_MAJOR >= 3) { Rmpfr_set_z_2exp($fr, $z, -2, MPFR_RNDN); if($fr == 1.25) {print "ok 84\n"} else { warn "84: \$fr: $fr\n"; print "not ok 84\n"; } } else { eval{Rmpfr_set_z_2exp($fr, $z, -2, MPFR_RNDN);}; if($@ =~ /Rmpfr_set_z_2exp not implemented/) {print "ok 84\n"} else { warn "84: \$\@: $@\n"; print "not ok 84\n"; } } } else { warn "Skipping test 84: No Math::GMP\n"; print "ok 84\n"; } my $nnum_val = Math::MPFR::nnumflag(); my $nnum_test = Math::MPFR->new('2 .3'); if(Math::MPFR::nnumflag() == $nnum_val + 1) {print "ok 85\n"} else { warn "\nnnumflag: expected ", $nnum_val + 1, ", got ", Math::MPFR::nnumflag(), "\n"; print "not ok 85\n"; } # Run the following to test Rmpfr_inp_str # and Rmpfr_dump __END__ print "\nEnter a number [eg .11235\@4]\n"; Rmpfr_inp_str($check, 10, GMP_RNDN); print "\n"; Rmpfr_dump($check); print "\n"; Math-MPFR-3.32/t/test2.t0000644000076400010400000000763112660557734016263 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); print "1..8\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my ($have_mpz, $have_gmp) = (0, 0); my $c = Rmpfr_init(); my $check2 = Rmpfr_init(); my $z; Rmpfr_set_default_prec(300); eval{require Math::GMP}; if(!$@) {$have_gmp = 1} eval{require Math::GMPz}; if(!$@) {$have_mpz = 1} if($have_gmp || $have_mpz) { if($have_gmp) {$z = Math::GMP->new("1123")} else {$z = Math::GMPz->new("1123")} Rmpfr_set_z($c, $z, GMP_RNDN); if($c == 1123 && Math::MPFR::get_refcnt($z) == 1 && (Math::MPFR::get_package_name($z) eq "Math::GMP" || Math::MPFR::get_package_name($z) eq "Math::GMPz")) {print "ok 1\n"} else {print "not ok 1\n"} } else { warn "Skipping test 1 - no Math::GMP or Math::GMPz\n"; print "ok 1\n"; } if($have_gmp || $have_mpz) { Rmpfr_set_prec($c, 53); Rmpfr_set_ui($c, 2, GMP_RNDN); if($have_gmp) {$z = Math::GMP->new(0)} else {$z = Math::GMPz->new(0)} my $exp = Rmpfr_get_z_exp($z, $c); if($exp == -51 && "$z" eq '4503599627370496' && (Math::MPFR::get_package_name($z) eq "Math::GMP" || Math::MPFR::get_package_name($z) eq "Math::GMPz")) {print "ok 2\n"} else {print "not ok 2\n"} } else { warn "Skipping test 2 - no Math::GMP or Math::GMPz\n"; print "ok 2\n"; } if($have_gmp || $have_mpz) { if($have_gmp) {$z = Math::GMP->new(11234)} else {$z = Math::GMPz->new(11234)} Rmpfr_set_prec($c, 300); Rmpfr_set_ui($c, 237, GMP_RNDN); Rmpfr_div_z($check2, $c, $z, GMP_RNDN); Rmpfr_mul_z($check2, $check2, $z, GMP_RNDN); if($check2 - $c > -0.000001 && $check2 - $c < 0.000001 && (Math::MPFR::get_package_name($z) eq "Math::GMP" || Math::MPFR::get_package_name($z) eq "Math::GMPz")) {print "ok 3\n"} else {print "not ok 3\n"} } else { warn "Skipping test 3 - no Math::GMP or Math::GMPz\n"; print "ok 3\n"; } if($have_gmp || $have_mpz) { if($have_gmp) {$z = Math::GMP->new("1123")} else {$z = Math::GMPz->new("1123")} my ($c, $cmp) = Rmpfr_init_set_z($z, GMP_RNDN); if($c == 1123 && Math::MPFR::get_refcnt($z) == 1 && (Math::MPFR::get_package_name($z) eq "Math::GMP" || Math::MPFR::get_package_name($z) eq "Math::GMPz")) {print "ok 4\n"} else {print "not ok 4\n"} } else { warn "Skipping test 4 - no Math::GMP or Math::GMPz\n"; print "ok 4\n"; } if($have_gmp || $have_mpz) { if($have_gmp) {$z = Math::GMP->new(17)} else {$z = Math::GMPz->new(17)} Rmpfr_set($check2, $c, GMP_RNDN); Rmpfr_add_z($c, $c, $z, GMP_RNDN); Rmpfr_sub_z($c, $c, $z, GMP_RNDN); if($c == $check2) {print "ok 5\n"} else {print "not ok 5\n"} } else { warn "Skipping test 5 - no Math::GMP or Math::GMPz\n"; print "ok 5\n"; } my $op1 = Math::MPFR->new(123); my $op2 = Math::MPFR->new(456); my $rop = Math::MPFR->new(); Rmpfr_dim($rop, $op1, $op2, GMP_RNDN); if($rop == 0) {print "ok 6\n"} else { warn "\n\$rop: $rop\n"; print "not ok 6\n"; } Rmpfr_dim($rop, $op2, $op1, GMP_RNDN); if($rop == 333) {print "ok 7\n"} else { warn "\n\$rop: $rop\n"; print "not ok 7\n"; } if($have_gmp || $have_mpz) { if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) { my $gmp; my $fr = Math::MPFR->new(10.25); if($have_gmp) {$gmp = Math::GMP->new(5)} else {$gmp = Math::GMPz->new(5)} my $ok = ''; Rmpfr_z_sub($fr, $gmp, $fr, GMP_RNDN); if($fr == -5.25) {print "ok 8\n"} else {print "not ok 8\n"} } else { my $z; my $fr = Math::MPFR->new(10.25); if($have_gmp) {$z = Math::GMP->new(5)} else {$z = Math::GMPz->new(5)} eval{Rmpfr_z_sub($fr, $z, $fr, GMP_RNDN);}; if($@ =~ /Rmpfr_z_sub not implemented/) {print "ok 8\n"} else { warn "\$\@: $@"; print "not ok 8\n"; } } } else { warn "Skipping test 8 - no Math::GMP or Math::GMPz\n"; print "ok 8\n"; } Math-MPFR-3.32/t/test3.t0000644000076400010400000001131112660557734016252 0ustar sisyphusAdministrators# Test the functions that became available with MPFR-2.1.0. use strict; use warnings; use Math::MPFR qw(:mpfr); print "1..21\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(300); my $rnd = 0; my $double = 1234567.0987; my $mpfr_nan = Rmpfr_init(); my $mpfr1 = Rmpfr_init(); my $mpfr2 = Rmpfr_init(); my $v; my($have_mpz, $have_mpf, $have_mpq, $have_gmp) = (0, 0, 0, 0); eval{require Math::GMPz}; if(!$@) {$have_mpz = 1} eval{require Math::GMPf}; if(!$@) {$have_mpf = 1} eval{require Math::GMPq}; if(!$@) {$have_mpq = 1} eval{require Math::GMP}; if(!$@) {$have_gmp = 1} Rmpfr_set_d($mpfr1, $double, $rnd); if($have_mpz) { my $ok = ''; my $z = Math::GMPz::Rmpz_init_set_ui(123456); my $cmp = Rmpfr_cmp_z($mpfr_nan, $z); if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'} Rmpfr_clear_erangeflag(); if(!Rmpfr_erangeflag_p()) {$ok .= 'b'} if(Rmpfr_cmp_z($mpfr1, $z) > 0) {$ok .= 'c'} my $ret = Rmpfr_get_z($z, $mpfr1, $rnd); if(MPFR_VERSION_MAJOR >= 3) { if(defined($ret)) {$ok .= 'D'} } else { if(!defined($ret)) {$ok .= 'D'} } Rmpfr_trunc($mpfr1, $mpfr1); if(!Rmpfr_cmp_z($mpfr1, $z)) {$ok .= 'd'} Rmpfr_set_d($mpfr1, $double, $rnd); if($ok eq 'abcDd') {print "ok 1\n"} else {print "not ok 1 $ok\n"} } else { warn "Skipping test 1 - no Math::GMPz\n"; print "ok 1\n"; } if($have_mpq) { my $ok = ''; my $q = Math::GMPq::Rmpq_init(); Math::GMPq::Rmpq_set_ui($q, 11, 17); my $cmp = Rmpfr_cmp_q($mpfr_nan, $q); if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'} Rmpfr_clear_erangeflag(); if(!Rmpfr_erangeflag_p()) {$ok .= 'b'} if(Rmpfr_cmp_q($mpfr1, $q) > 0) {$ok .= 'c'} if($ok eq 'abc') {print "ok 2\n"} else {print "not ok 2 $ok\n"} } else { warn "Skipping test 2 - no Math::GMPq\n"; print "ok 2\n"; } if($have_mpf) { my $ok = ''; my $f = Math::GMPf::Rmpf_init_set_d(123456.12); my $cmp = Rmpfr_cmp_f($mpfr_nan, $f); if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'} Rmpfr_clear_erangeflag(); if(!Rmpfr_erangeflag_p()) {$ok .= 'b'} if(Rmpfr_cmp_f($mpfr1, $f) > 0) {$ok .= 'c'} if($ok eq 'abc') {print "ok 3\n"} else {print "not ok 3 $ok\n"} } else { warn "Skipping test 3 - no Math::GMPf\n"; print "ok 3\n"; } if($have_gmp) { my $ok = ''; my $z = Math::GMP->new(123456); my $cmp = Rmpfr_cmp_z($mpfr_nan, $z); if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'} Rmpfr_clear_erangeflag(); if(!Rmpfr_erangeflag_p()) {$ok .= 'b'} if(Rmpfr_cmp_z($mpfr1, $z) > 0) {$ok .= 'c'} Rmpfr_get_z($z, $mpfr1, $rnd); Rmpfr_trunc($mpfr1, $mpfr1); if(!Rmpfr_cmp_z($mpfr1, $z)) {$ok .= 'd'} Rmpfr_set_d($mpfr1, $double, $rnd); if($ok eq 'abcd') {print "ok 4\n"} else {print "not ok 4 $ok\n"} } else { warn "Skipping test 4 - no Math::GMP\n"; print "ok 4\n"; } Rmpfr_set_ui_2exp($mpfr2, 5, 3, $rnd); if($mpfr2 == 40) {print "ok 5\n"} else {print "not ok 5\n"} Rmpfr_set_si_2exp($mpfr2, 5, 3, $rnd); if($mpfr2 == 40) {print "ok 6\n"} else {print "not ok 6\n"} Rmpfr_set_si_2exp($mpfr2, 8, -3, $rnd); if($mpfr2 == 1) {print "ok 7\n"} else {print "not ok 7\n"} Rmpfr_sub_si($mpfr2, $mpfr2, -11, $rnd); if($mpfr2 == 12) {print "ok 8\n"} else {print "not ok 8\n"} Rmpfr_si_sub($mpfr2, -11, $mpfr2, $rnd); if($mpfr2 == -23) {print "ok 9\n"} else {print "not ok 9\n"} Rmpfr_mul_si($mpfr2, $mpfr2, -11, $rnd); if($mpfr2 == 253) {print "ok 10\n"} else {print "not ok 10\n"} Rmpfr_div_si($mpfr2, $mpfr2, -11, $rnd); if($mpfr2 == -23) {print "ok 11\n"} else {print "not ok 11\n"} $mpfr2++; Rmpfr_si_div($mpfr2, -11, $mpfr2, $rnd); if($mpfr2 == 0.5) {print "ok 12\n"} else {print "not ok 12\n"} Rmpfr_mul($mpfr1, $mpfr2, $mpfr2, $rnd); Rmpfr_sqr($mpfr2, $mpfr2, $rnd); if($mpfr1 == $mpfr2) {print "ok 13\n"} else {print "not ok 13\n"} Rmpfr_const_pi($mpfr1, $rnd); if(!Rmpfr_zero_p($mpfr1)) {print "ok 14\n"} else {print "not ok 14\n"} eval{Rmpfr_free_cache();}; if(!$@) {print "ok 15\n"} else {print "not ok 15: $@\n"} eval{$v = Rmpfr_get_version();}; if(!$@ && $v) {print "ok 16\n"} else {print "not ok 16: $@\n"} if((Rmpfr_get_emin_min() <= Rmpfr_get_emin_max()) && (Rmpfr_get_emax_min() <= Rmpfr_get_emax_max())) {print "ok 17\n"} else {print "not ok 17\n"} Rmpfr_set_d($mpfr1, $double, $rnd); Rmpfr_rint_ceil($mpfr2, $mpfr1, $rnd); if($mpfr2 == 1234568) {print "ok 18\n"} else {print "not ok 18\n"} Rmpfr_rint_floor($mpfr2, $mpfr1, $rnd); if($mpfr2 == 1234567) {print "ok 19\n"} else {print "not ok 19\n"} Rmpfr_rint_round($mpfr2, $mpfr1, $rnd); if($mpfr2 == 1234567) {print "ok 20\n"} else {print "not ok 20\n"} Rmpfr_rint_trunc($mpfr2, $mpfr1, $rnd); if($mpfr2 == 1234567) {print "ok 21\n"} else {print "not ok 21\n"} Math-MPFR-3.32/t/test4.t0000644000076400010400000003304312660557734016261 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); use Config; print "1..49\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $have_mpq = 0; my $ok; eval{require Math::GMPq}; if(!$@) {$have_mpq = 1} Rmpfr_set_default_rounding_mode(GMP_RNDZ); if(Rmpfr_get_default_rounding_mode() == GMP_RNDZ) {print "ok 1\n"} else {print "not ok 1\n"} Rmpfr_set_default_rounding_mode(GMP_RNDN); if(Rmpfr_get_default_rounding_mode() == GMP_RNDN) {print "ok 2\n"} else {print "not ok 2\n"} Rmpfr_set_default_prec(300); my $f = Rmpfr_init(); Rmpfr_set_d($f, 13.5, GMP_RNDN); my $ret = Rmpfr_prec_round($f, 70, GMP_RNDN); if($ret == 0 && $f == 13.5 && Rmpfr_get_prec($f) == 70) {print "ok 3\n"} else {print "not ok 3\n"} my $emin = Rmpfr_get_emin(); my $emax = Rmpfr_get_emax(); $emin++; $emax--; if(!Rmpfr_set_emin($emin)) {print "ok 4\n"} else {print "not ok 4\n"} if(!Rmpfr_set_emax($emax)) {print "ok 5\n"} else {print "not ok 5\n"} if(Rmpfr_get_emin() == $emin && Rmpfr_get_emax() == $emax) {print "ok 6\n"} else {print "not ok 6\n"} $emin--; $emax++; if(!Rmpfr_set_emin($emin)) {print "ok 7\n"} else {print "not ok 7\n"} if(!Rmpfr_set_emax($emax)) {print "ok 8\n"} else {print "not ok 8\n"} if(Rmpfr_get_emin() == $emin && Rmpfr_get_emax() == $emax) {print "ok 9\n"} else {print "not ok 9\n"} $ok = ''; my $fma = Rmpfr_init(); my $m = Rmpfr_init(); my $a = Rmpfr_init(); Rmpfr_set_d($m, 121.5, GMP_RNDN); Rmpfr_set_d($a, 23.25, GMP_RNDN); Rmpfr_fma($fma, $f, $m, $a, GMP_RNDN); if($fma == 1663.5) {$ok .= 'a'} Rmpfr_fms($fma, $f, $m, $a, GMP_RNDN); if($fma == 1617) {$ok .= 'b'} if($ok eq 'ab') {print "ok 10\n"} else {print "not ok 10 $ok\n"} Rmpfr_sqrt_ui($fma, 2, GMP_RNDN); if($fma > 1.414213 && $fma < 1.414214) {print "ok 11\n"} else {print "not ok 11\n"} if(!Rmpfr_equal_p($fma, $m) && Rmpfr_lessgreater_p($fma, $m)) {print "ok 12\n"} else {print "not ok 12\n"} if(Rmpfr_lessequal_p($fma, $m) && Rmpfr_less_p($fma, $m) && Rmpfr_greater_p($m, $fma) && Rmpfr_greaterequal_p($m, $fma)) {print "ok 13\n"} else {print "not ok 13\n"} Rmpfr_fac_ui($fma, 10, GMP_RNDN); if($fma == 3628800) {print "ok 14\n"} else {print "not ok 14\n"} my $angle = Rmpfr_init(); my $s = Rmpfr_init(); my $c = Rmpfr_init(); Rmpfr_set_d($angle, 3.217, GMP_RNDN); Rmpfr_sin($s, $angle, GMP_RNDN); Rmpfr_cos($c, $angle, GMP_RNDN); Rmpfr_pow_ui($s, $s, 2, GMP_RNDN); Rmpfr_pow_ui($c, $c, 2, GMP_RNDN); Rmpfr_add($s, $s, $c, GMP_RNDN); if($s > 0.9999999 && $s < 1.00000001) {print "ok 15\n"} else {print "not ok 15\n"} $ret = Rmpfr_log1p($fma, $fma, GMP_RNDN); if($ret && $fma > 15.104412848648 && $fma < 15.104412848649) {print "ok 16\n"} else {print "not ok 16\n"} $ret = Rmpfr_expm1($fma, $fma, GMP_RNDN); if($ret && $fma > 3628799.99999 && $fma < 3628800.00001) {print "ok 17\n"} else {print "not ok 17\n"} $f *= -1; $ret = Rmpfr_frac($f, $f, GMP_RNDN); if(!$ret && $f == -0.5) {print "ok 18\n"} else {print "not ok 18\n"} my $next = Rmpfr_init(); Rmpfr_nexttoward($f, $next); if(Rmpfr_nan_p($f)) {print "ok 19\n"} else {print "not ok 19\n"} Rmpfr_set_d($f, 10.5, GMP_RNDN); Rmpfr_set_d($m, 11.5, GMP_RNDN); Rmpfr_nexttoward($f, $m); if($f > 10.5 && $f < 10.50001) {print "ok 20\n"} else {print "not ok 20\n"} Rmpfr_set_d($f, 10.5, GMP_RNDN); Rmpfr_nextabove($f); if($f > 10.5 && $f < 10.50001) {print "ok 21\n"} else {print "not ok 21\n"} Math::MPFR::Rmpfr_nextbelow($f); if($f == 10.5) {print "ok 22\n"} else {print "not ok 22\n"} Rmpfr_nextabove($next); if(Rmpfr_nan_p($next)) {print "ok 23\n"} else {print "not ok 23\n"} Math::MPFR::Rmpfr_nextbelow($next); if(Rmpfr_nan_p($next)) {print "ok 24\n"} else {print "not ok 24\n"} $ret = Rmpfr_ui_pow_ui($fma, 7, 5, GMP_RNDN); if(!$ret && $fma == 16807) {print "ok 25\n"} else {print "not ok 25\n"} Rmpfr_set_d($f, 1.23456789, GMP_RNDU); $ret = Rmpfr_ui_pow($fma, 7, $f, GMP_RNDN); if($ret && $fma > 11.049201764 && $fma < 11.049201765) {print "ok 26\n"} else {print "not ok 26\n"} $ret = Rmpfr_pow_si($fma, $f, -3, GMP_RNDN); if($ret && $fma > 0.531441014 && $fma < 0.531441015) {print "ok 27\n"} else {print "not ok 27\n"} Rmpfr_set_d($f, 0.25, GMP_RNDN); $ret = Rmpfr_cmp_ui_2exp($f, 2, -3); if(!$ret) {print "ok 28\n"} else {print "not ok 28\n"} $f *= -1; $ret = Rmpfr_cmp_si_2exp($f, -2, -3); if(!$ret) {print "ok 29\n"} else {print "not ok 29\n"} eval {Rmpfr_set_str_binary($f, '-1000.11E-3')}; if($@) {print "ok 30\n"} else {print "not ok 30\n"} Rmpfr_set_str($f, '-1000.11E-3', 2, MPFR_RNDN); $f *= -1; if($have_mpq) { my $q = Math::GMPq::Rmpq_init(); Math::GMPq::Rmpq_set_ui($q, 11, 17); Rmpfr_add_q($f, $f, $q, GMP_RNDN); Rmpfr_sub_q($f, $f, $q, GMP_RNDN); if($f > 1.0937499 && $f < 1.0937501) {print "ok 31\n"} else {print "not ok 31\n"} } else { warn "Skipping test 31 - no Math::GMPq\n"; print "ok 31\n"; } my ($u1, $cmp1) = Rmpfr_init_set_str('1.a', 16, GMP_RNDN); if(!$cmp1) {print "ok 32\n"} else {print "not ok 32\n"} my ($u2, $cmp2) = Rmpfr_init_set_str('1.a', 10, GMP_RNDZ); if($cmp2 == -1) {print "ok 33\n"} else {print "not ok 33\n"} #################################### $ok = ''; #my $h = Rmpfr_init2(59); #Rmpfr_set_str_binary ($h, "-0.10010001010111000011110010111010111110000000111101100111111E663"); #if (Rmpfr_can_round ($h, 54, GMP_RNDZ, GMP_RNDZ, 53) != 0) {$ok = 'E'} #else {$ok = 'a'} # #Rmpfr_set_str_binary ($h, "-Inf"); #if (Rmpfr_can_round ($h, 2000, GMP_RNDZ, GMP_RNDZ, 2000) != 0) {$ok .= 'E'} #else {$ok .= 'b'} # #Rmpfr_set_prec ($h, 64); #Rmpfr_set_str_binary ($h, "0.1011001000011110000110000110001111101011000010001110011000000000"); #if (Rmpfr_can_round ($h, 65, GMP_RNDN, GMP_RNDN, 54)) {$ok .= 'E'} #else {$ok .= 'c'} # #if($ok eq 'abc') {print "ok 34\n"} #else {print "not ok 34 $ok\n"} print "ok 34\n"; # test removed because Rmpfr_set_str_binary no longer implemented my $k = Rmpfr_init2(53); my $str = '1' x 53; Rmpfr_set_str($k, $str, 2, GMP_RNDN); my @deref = Math::MPFR::Rmpfr_deref2($k, 10, 0, GMP_RNDN); if($deref[0] eq '90071992547409910') {print "ok 35\n"} else {print "not ok 35 $deref[0]\n"} $ok = ''; if($Config::Config{longsize} == 8) { if(Rmpfr_fits_ulong_p($k, GMP_RNDN) && Rmpfr_fits_slong_p($k, GMP_RNDN)) {$ok = 'a'} } else { if(!Rmpfr_fits_ulong_p($k, GMP_RNDN) && !Rmpfr_fits_slong_p($k, GMP_RNDN)) {$ok = 'a'} } Rmpfr_set_d($k, 123.456789, GMP_RNDN); if(Rmpfr_fits_ulong_p($k, GMP_RNDN) && Rmpfr_fits_slong_p($k, GMP_RNDN)) {$ok .= 'b'} Rmpfr_set_d($k, 2147483648.4444, GMP_RNDN); if($Config::Config{longsize} == 8) { if(Rmpfr_fits_ulong_p($k, GMP_RNDN) && Rmpfr_fits_slong_p($k, GMP_RNDN)) {$ok .= 'c'} } else { if(Rmpfr_fits_ulong_p($k, GMP_RNDN) && !Rmpfr_fits_slong_p($k, GMP_RNDN)) {$ok .= 'c'} } if($ok eq 'abc') {print "ok 36\n"} else {print "not ok 36 $ok\n"} if(Rmpfr_get_ui($k, GMP_RNDN) == 2147483648) {print "ok 37\n"} else {print "not ok 37\n"} Rmpfr_set_si($k, -2147483647, GMP_RNDN); if(Rmpfr_get_si($k, GMP_RNDN) == -2147483647) {print "ok 38\n"} else {print "not ok 38\n"} my $u = Math::MPFR->new(256); if(Rmpfr_fits_intmax_p($u, GMP_RNDN) && Rmpfr_fits_sint_p($u, GMP_RNDN) && Rmpfr_fits_slong_p($u, GMP_RNDN) && Rmpfr_fits_sshort_p($u, GMP_RNDN) && Rmpfr_fits_uint_p($u, GMP_RNDN) && Rmpfr_fits_uintmax_p($u, GMP_RNDN) && Rmpfr_fits_ulong_p($u, GMP_RNDN) && Rmpfr_fits_ushort_p($u, GMP_RNDN)) {print "ok 39\n"} else {print "not ok 39\n"} my $bits = $Config{ivsize} * 8; Rmpfr_set_default_prec($bits + 5); my $check = '10111101111110100101110101101111011111101001011111011011110110110010010111110110111101111110100100110101'; my $shigh; $ok = ''; { use integer; my $temp = (2 ** ($bits - 2)) - 1; $shigh = (2 * $temp) + 1; } my $uhigh = (2 * $shigh) + 1; my $ulow = 0; my $slow = ($shigh * -1) - 1; my @obj= ( Math::MPFR->new($uhigh), Math::MPFR->new($shigh), Math::MPFR->new($ulow), Math::MPFR->new($slow), Math::MPFR->new($shigh) + Math::MPFR->new(0.299), Math::MPFR->new($shigh) - Math::MPFR->new(0.239), Math::MPFR->new($uhigh) + Math::MPFR->new(0.467), Math::MPFR->new($uhigh) - Math::MPFR->new(0.6), Math::MPFR->new($slow) + Math::MPFR->new(0.299), Math::MPFR->new($slow) - Math::MPFR->new(0.239), Math::MPFR->new($ulow) + Math::MPFR->new(0.467), Math::MPFR->new($ulow) - Math::MPFR->new(0.6), Math::MPFR->new(-1), ); #for(my $i = 0; $i < @obj; $i++) { # if($obj[$i] <= 0 && $obj[$i] > -1.0){print "$i: $obj[$i]\n"} #} my @rnd = (GMP_RNDN, GMP_RNDZ, GMP_RNDU, GMP_RNDD); for(my $j = 0; $j < 4; $j++) { for(my $i = 0; $i < 13; $i++) { $ok .= Rmpfr_fits_UV_p($obj[$i], $rnd[$j]); $ok .= Rmpfr_fits_IV_p($obj[$i], $rnd[$j]); } } my $icheck = have_get_IV(); my $ucheck = have_get_UV(); if($] < 5.007 && !Math::MPFR::_has_longdouble() && Math::MPFR::_has_longlong()) { warn "Skipping tests 40 and 41 as they fail on perl 5.6\nbuilt with -Duse64bitint but without -Duselongdouble\n"; print "ok 40\n"; print "ok 41\n"; } else { if($ok eq $check) {print "ok 40\n"} else { warn "\nGot: $ok\nExpected: $check\n"; print "not ok 40\n"; } $ok = ''; if($ucheck) { for(@rnd) { if(Math::MPFR::_has_longlong()) { # No mpfr_cmp_uj() is yet available Rmpfr_set_default_rounding_mode($_); if(!Rmpfr_cmp($obj[0], Math::MPFR->new(Rmpfr_get_UV($obj[0], $_)))) {$ok .= $_} if(!Rmpfr_cmp($obj[2], Math::MPFR->new(Rmpfr_get_UV($obj[2], $_)))) {$ok .= $_} } else { if(!Rmpfr_cmp_ui($obj[0], Rmpfr_get_UV($obj[0], $_))) {$ok .= $_} if(!Rmpfr_cmp_ui($obj[2], Rmpfr_get_UV($obj[2], $_))) {$ok .= $_} } } if($ok eq '00112233') {print "ok 41\n"} else { warn $ok, "\n"; print "not ok 41 \n"; } } else { warn "Skipping test 41 - Rmpfr_get_UV() not implemented\n"; print "ok 41\n"; } } Rmpfr_set_default_rounding_mode(GMP_RNDN); $ok = ''; if($icheck) { for(@rnd) { if(Math::MPFR::_has_longlong()) { # No mpfr_cmp_sj is yet available Rmpfr_set_default_rounding_mode($_); if(!Rmpfr_cmp($obj[1], Math::MPFR->new(Rmpfr_get_IV($obj[1], $_)))) {$ok .= $_} if(!Rmpfr_cmp($obj[3], Math::MPFR->new(Rmpfr_get_IV($obj[3], $_)))) {$ok .= $_} } else { if(!Rmpfr_cmp_si($obj[1], Rmpfr_get_IV($obj[1], $_))) {$ok .= $_} if(!Rmpfr_cmp_si($obj[3], Rmpfr_get_IV($obj[3], $_))) {$ok .= $_} } } if($ok eq '00112233') {print "ok 42\n"} else { warn $ok, "\n"; print "not ok 42 \n"; } } else { warn "Skipping test 42 - Rmpfr_get_IV() not implemented\n"; print "ok 42\n"; } Rmpfr_set_default_rounding_mode(GMP_RNDN); my $double = 17.625; if($double == Rmpfr_get_NV(Math::MPFR->new($double), GMP_RNDN)) {print "ok 43\n"} else { warn "\nGot: ", Rmpfr_get_NV(Math::MPFR->new($double), GMP_RNDN) , "\nExpected: $double\n"; print "not ok 43\n"; } $ok = ''; if(MPFR_VERSION_MAJOR >= 3) { if(Rmpfr_regular_p(Math::MPFR->new(17))) {$ok .= 'a'} if(!Rmpfr_regular_p(Math::MPFR->new(0))) {$ok .= 'b'} if(!Rmpfr_regular_p(Math::MPFR->new())) {$ok .= 'c'} if(!Rmpfr_regular_p(Math::MPFR->new(-1) / Math::MPFR->new(0))) {$ok .= 'd'} if(!Rmpfr_regular_p(Math::MPFR->new(1) / Math::MPFR->new(0))) {$ok .= 'e'} if($ok eq 'abcde') {print "ok 44\n"} else { warn "44: \$ok: $ok\n"; print "not ok 44\n"; } Rmpfr_set_zero($fma, -1); if($fma == 0) {print "ok 45\n"} else { warn "45: \$fma: $fma\n"; print "not ok 45\n"; } my $dig1 = Math::MPFR->new(); my $dig2 = Math::MPFR->new(); Rmpfr_digamma($dig1, Math::MPFR->new(2), MPFR_RNDN); Rmpfr_digamma($dig2, Math::MPFR->new(3), MPFR_RNDN); # Let's check the recurrence relation my $diff = $dig2 - ($dig1 + 0.5); if($diff < 0.00000000001 && $diff > -0.00000000001) {print "ok 46\n"} else { warn "46: \$diff: $diff\n"; print "not ok 1\n"; } my $ai = Math::MPFR->new(); Rmpfr_ai($ai, 1 / Math::MPFR->new(0), MPFR_RNDN); if($ai == 0) {print "ok 47\n"} else { warn "47: \$ai: $ai\n"; print "not ok 47\n"; } my $flt = Rmpfr_get_flt(Math::MPFR->new(0.25), MPFR_RNDN); if($flt == 0.25) {print "ok 48\n"} else { warn "48: \$flt: $flt\n"; print "not ok 48\n"; } Rmpfr_set_flt($ai, 0.25, MPFR_RNDN); if($ai == 0.25) {print "ok 49\n"} else { warn "49: \$ai: $ai\n"; print "not ok 49\n"; } } else { eval{Rmpfr_regular_p(Math::MPFR->new())}; if($@ =~ /Rmpfr_regular_p not implemented/) {print "ok 44\n"} else { warn "44: \$\@: $@\n"; print "not ok 44\n"; } eval{Rmpfr_set_zero($fma, -1);}; if($@ =~ /Rmpfr_set_zero not implemented/) {print "ok 45\n"} else { warn "45: \$\@: $@\n"; print "not ok 45\n"; } eval{Rmpfr_digamma($fma, $fma, MPFR_RNDN);}; if($@ =~ /Rmpfr_digamma not implemented/) {print "ok 46\n"} else { warn "46: \$\@: $@\n"; print "not ok 46\n"; } eval{Rmpfr_ai($fma, $fma, MPFR_RNDN);}; if($@ =~ /Rmpfr_ai not implemented/) {print "ok 47\n"} else { warn "47: \$\@: $@\n"; print "not ok 47\n"; } eval{my $flt = Rmpfr_get_flt($fma, MPFR_RNDN);}; if($@ =~ /Rmpfr_get_flt not implemented/) {print "ok 48\n"} else { warn "48: \$\@: $@\n"; print "not ok 48\n"; } eval{Rmpfr_set_flt($fma, 0.3, MPFR_RNDN);}; if($@ =~ /Rmpfr_set_flt not implemented/) {print "ok 49\n"} else { warn "49: \$\@: $@\n"; print "not ok 49\n"; } } ########################################## ########################################## sub have_get_IV { eval{Rmpfr_get_IV(Math::MPFR->new(0));}; if($@) { return 0 if $@ =~ /not implemented/; } return 1; } sub have_get_UV { eval{Rmpfr_get_UV(Math::MPFR->new(0));}; if($@) { return 0 if $@ =~ /not implemented/; } return 1; } Math-MPFR-3.32/t/tls.t0000644000076400010400000001314012660557734016014 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); my $cut = eval 'use threads; 1'; print "1..3\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; if($cut) { if($threads::VERSION < 1.71) { warn "Skipping all tests - need at least threads-1.71, we have version $threads::VERSION\n"; print "ok 1\n"; print "ok 2\n"; print "ok 3\n"; exit(0); } } my ($tls, $ok, $pid); eval {$tls = Rmpfr_buildopt_tls_p();}; my $cut_mess = $cut ? '' : "ithreads not available with this build of perl\n"; my $tls_mess = $tls ? '' : $@ ? "Unable to determine whether mpfr was built with '--enable-thread-safe'\n" : "Your mpfr library was not built with '--enable-thread-safe'\n"; if($cut && $tls) { # perform tests Rmpfr_set_default_prec(101); my $thr1 = threads->create( sub { Rmpfr_set_default_prec(201); return Rmpfr_get_default_prec(); } ); my $res = $thr1->join(); if($res == 201 && Rmpfr_get_default_prec() == 101) {$ok .= 'a'} else {warn "\n1a: \$res: $res\n prec: ", Rmpfr_get_default_prec(), "\n"} # Needs TLS to work correctly on MS Windows if($pid = fork()) { Rmpfr_set_default_prec(102); waitpid($pid,0); } else { sleep 1; Rmpfr_set_default_prec(202); _save(Rmpfr_get_default_prec()); exit(0); } sleep 2; if(Rmpfr_get_default_prec() == 102) {$ok .= 'b'} else {warn "\n1b: prec: ", Rmpfr_get_default_prec(), "\n"} my $f = _retrieve(); if($f == 999999) { warn "Skipping test 1c - couldn't open 'save_child_setting.txt'"; $ok .= 'c'; } elsif($f == 202) { $ok .= 'c'; } else { warn "\n1c: prec: $f\n"; } if($ok eq 'abc') {print "ok 1\n"} else { warn "\$ok: $ok\n"; print "not ok 1\n"; } ####################### $ok = ''; Rmpfr_set_default_rounding_mode(GMP_RNDZ); my $thr2 = threads->create( sub { Rmpfr_set_default_rounding_mode(GMP_RNDU); return Rmpfr_get_default_rounding_mode(); } ); $res = $thr2->join(); if($res == GMP_RNDU && Rmpfr_get_default_rounding_mode() == GMP_RNDZ) {$ok .= 'a'} else {warn "\n2a: \$res: $res\n rounding: ", Rmpfr_get_default_rounding_mode(), "\n"} # Needs TLS to work correctly on MS Windows if($pid = fork()) { Rmpfr_set_default_rounding_mode(GMP_RNDU); waitpid($pid,0); } else { sleep 1; Rmpfr_set_default_rounding_mode(GMP_RNDD); _save(Rmpfr_get_default_rounding_mode()); exit(0); } sleep 2; if(Rmpfr_get_default_rounding_mode() == GMP_RNDU) {$ok .= 'b'} else {warn "\n2b: rounding: ", Rmpfr_get_default_rounding_mode(), "\n"} $f = _retrieve(); if($f == 999999) { warn "Skipping test 2c - couldn't open 'save_child_setting.txt'"; $ok .= 'c'; } elsif($f == GMP_RNDD) { $ok .= 'c'; } else { warn "\n2c: rounding: $f\n"; } if($ok eq 'abc') {print "ok 2\n"} else { warn "\$ok: $ok\n"; print "not ok 2\n"; } ####################### $ok = ''; Rmpfr_set_default_rounding_mode(GMP_RNDN); Rmpfr_set_default_prec(103); my $thr3 = threads->create( {'context' => 'list'}, sub { Rmpfr_set_default_prec(203); Rmpfr_set_default_rounding_mode(GMP_RNDU); return (Rmpfr_get_default_prec(), Rmpfr_get_default_rounding_mode()); } ); my @res = $thr3->join(); if($res[0] == 203 && $res[1] == GMP_RNDU && Rmpfr_get_default_prec() == 103 && Rmpfr_get_default_rounding_mode() == GMP_RNDN) {$ok .= 'a'} else {warn "\n3a: \$res[0]: $res[0]\n \$res[1]: $res[1]\n prec: ", Rmpfr_get_default_prec(), "\n rounding: ", Rmpfr_get_default_rounding_mode(), "\n"} # Needs TLS to work correctly on MS Windows if($pid = fork()) { Rmpfr_set_default_prec(104); Rmpfr_set_default_rounding_mode(GMP_RNDU); waitpid($pid,0); } else { sleep 1; Rmpfr_set_default_prec(204); Rmpfr_set_default_rounding_mode(GMP_RNDD); my $p = Rmpfr_get_default_prec(); my $r = Rmpfr_get_default_rounding_mode(); _save("$p $r"); exit(0); } sleep 2; if(Rmpfr_get_default_rounding_mode() == GMP_RNDU && Rmpfr_get_default_prec() == 104) {$ok .= 'b'} else {warn "\n3b: prec: ", Rmpfr_get_default_prec(), "\n rounding: ", Rmpfr_get_default_rounding_mode(), "\n"} my @f = _retrieve(); if($f[0] == 999999) { warn "Skipping test 3c - couldn't open 'save_child_setting.txt'"; $ok .= 'c'; } elsif($f[0] == 204 && $f[1] == GMP_RNDD) { $ok .= 'c'; } else { warn "\n3c: prec: $f[0] rounding: $f[1]\n"; } if($ok eq 'abc') {print "ok 3\n"} else { warn "\$ok: $ok\n"; print "not ok 3\n"; } ####################### } else { warn "Skipping all tests: ${cut_mess}${tls_mess}"; print "ok 1\n"; print "ok 2\n"; print "ok 3\n"; } sub _save { unless (open(WR, '>', 'save_child_setting.txt')) { warn "Can't open file 'save_child_setting.txt' for writing : $!"; return 0; } print WR $_[0]; return 1; } sub _retrieve { unless (open (RD, '<', 'save_child_setting.txt')) { warn "Can't open file 'save_child_setting.txt' for reading: $!"; return 999999; } my @ret; my $ret = ; chomp $ret; if($ret =~ / /) { @ret = split / /, $ret; return @ret; } return $ret; } Math-MPFR-3.32/t/tls_flags.t0000644000076400010400000001111112660557734017164 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); my $cut = eval 'use threads; 1'; print "1..1\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; if($cut) { if($threads::VERSION < 1.71) { warn "Skipping this test script - need at least threads-1.71, we have version $threads::VERSION\n"; print "ok 1\n"; exit(0); } } my ($tls, $ok); eval {$tls = Rmpfr_buildopt_tls_p();}; my $cut_mess = $cut ? '' : "ithreads not available with this build of perl\n"; my $tls_mess = $tls ? '' : $@ ? "Unable to determine whether mpfr was built with '--enable-thread-safe'\n" : "Your mpfr library was not built with '--enable-thread-safe'\n"; if($cut && $tls) { # perform tests #### my $thr1 = threads->create( {'context' => 'list'}, sub { my @ret; $ret[0] = Rmpfr_underflow_p() ? 1 : 0; Rmpfr_set_underflow(); $ret[1] = Rmpfr_underflow_p() ? 1 : 0; return @ret; } ); my @r = $thr1->join(); if($r[0] == 0 && $r[1] == 1) {$ok .= 'a'} else {warn "1a: \$r[0]: $r[0] \$r[1]: $r[1]\n"} if(!Rmpfr_underflow_p()) {$ok .= 'b'} else {warn "1b: Underflow set\n"} #### #### my $thr2 = threads->create( {'context' => 'list'}, sub { my @ret; $ret[0] = Rmpfr_overflow_p() ? 1 : 0; Rmpfr_set_overflow(); $ret[1] = Rmpfr_overflow_p() ? 1 : 0; return @ret; } ); @r = $thr2->join(); if($r[0] == 0 && $r[1] == 1) {$ok .= 'c'} else {warn "1c: \$r[0]: $r[0] \$r[1]: $r[1]\n"} if(!Rmpfr_overflow_p()) {$ok .= 'd'} else {warn "1d: Overflow set\n"} #### #### my $thr3 = threads->create( {'context' => 'list'}, sub { my @ret; $ret[0] = Rmpfr_nanflag_p() ? 1 : 0; Rmpfr_set_nanflag(); $ret[1] = Rmpfr_nanflag_p() ? 1 : 0; return @ret; } ); @r = $thr3->join(); if($r[0] == 0 && $r[1] == 1) {$ok .= 'e'} else {warn "1e: \$r[0]: $r[0] \$r[1]: $r[1]\n"} if(!Rmpfr_nanflag_p()) {$ok .= 'f'} else {warn "1f: Nanflag set\n"} #### #### my $thr4 = threads->create( {'context' => 'list'}, sub { my @ret; $ret[0] = Rmpfr_inexflag_p() ? 1 : 0; Rmpfr_set_inexflag(); $ret[1] = Rmpfr_inexflag_p() ? 1 : 0; return @ret; } ); @r = $thr4->join(); if($r[0] == 0 && $r[1] == 1) {$ok .= 'g'} else {warn "1g: \$r[0]: $r[0] \$r[1]: $r[1]\n"} if(!Rmpfr_inexflag_p()) {$ok .= 'h'} else {warn "1h: Inexflag set\n"} #### #### my $thr5 = threads->create( {'context' => 'list'}, sub { my @ret; $ret[0] = Rmpfr_erangeflag_p() ? 1 : 0; Rmpfr_set_erangeflag(); $ret[1] = Rmpfr_erangeflag_p() ? 1 : 0; return @ret; } ); @r = $thr5->join(); if($r[0] == 0 && $r[1] == 1) {$ok .= 'i'} else {warn "1i: \$r[0]: $r[0] \$r[1]: $r[1]\n"} if(!Rmpfr_erangeflag_p()) {$ok .= 'j'} else {warn "1j: Underflow set\n"} #### #### my $thr6 = threads->create( {'context' => 'list'}, sub { my @ret; $ret[0] = Rmpfr_divby0_p() ? 1 : 0; Rmpfr_set_divby0(); $ret[1] = Rmpfr_divby0_p() ? 1 : 0; return @ret; } ); @r = $thr6->join(); if($r[0] == 0 && $r[1] == 1) {$ok .= 'k'} else {warn "1k: \$r[0]: $r[0] \$r[1]: $r[1]\n"} if(!Rmpfr_divby0_p()) {$ok .= 'l'} else {warn "1l: Divide-by-zero set\n"} #### if($ok eq 'abcdefghijkl') {print "ok 1\n"} else { warn "\$ok: $ok\n"; print "not ok 1\n"; } } else { warn "Skipping all tests: ${cut_mess}${tls_mess}"; print "ok 1\n"; } Math-MPFR-3.32/t/trig.t0000644000076400010400000001166112660557734016165 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); use Math::Trig; # for checking results print "1..17\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(100); my $angle = 2.2314; #13.2314; my $inv = 0.5123; my $angle2 = $angle * $inv; my $hangle = 0.1234; my $invatanh = 0.991; my $hinv = 1.4357; my $sin = Rmpfr_init(); my $cos = Rmpfr_init(); my $tan = Rmpfr_init(); my $asin = Rmpfr_init(); my $acos = Rmpfr_init(); my $atan = Rmpfr_init(); my $atan2 = Rmpfr_init(); my $sinh = Rmpfr_init(); my $cosh = Rmpfr_init(); my $tanh = Rmpfr_init(); my $asinh = Rmpfr_init(); my $acosh = Rmpfr_init(); my $atanh = Rmpfr_init(); my $b_angle = Rmpfr_init(); my $b_angle2 = Rmpfr_init(); my $b_inv = Rmpfr_init(); my $b_hangle = Rmpfr_init(); my $b_invatanh = Rmpfr_init(); my $b_hinv = Rmpfr_init(); my $rop = Rmpfr_init(); Rmpfr_set_d($b_angle, $angle, GMP_RNDN); Rmpfr_set_d($b_angle2, $angle2, GMP_RNDN); Rmpfr_set_d($b_inv, $inv, GMP_RNDN); Rmpfr_set_d($b_invatanh, $invatanh, GMP_RNDN); Rmpfr_set_d($b_hinv, $hinv, GMP_RNDN); Rmpfr_set_d($b_hangle, $hangle, GMP_RNDN); Rmpfr_sin($sin, $b_angle, GMP_RNDN); if($sin - sin($angle) < 0.00001 && $sin - sin($angle) > -0.00001) {print "ok 1\n"} else {print "not ok 1\n"} Rmpfr_cos($cos, $b_angle, GMP_RNDN); if($cos - cos($angle) < 0.00001 && $cos - cos($angle) > -0.00001) {print "ok 2\n"} else {print "not ok 2\n"} Rmpfr_tan($tan, $b_angle, GMP_RNDN); if($tan - tan($angle) < 0.00001 && $tan - tan($angle) > -0.00001) {print "ok 3\n"} else {print "not ok 3\n"} Rmpfr_asin($asin, $b_inv, GMP_RNDN); if($asin - asin($inv) < 0.00001 && $asin - asin($inv) > -0.00001) {print "ok 4\n"} else {print "not ok 4\n"} Rmpfr_acos($acos, $b_inv, GMP_RNDN); if($acos - acos($inv) < 0.00001 && $acos - acos($inv) > -0.00001) {print "ok 5\n"} else {print "not ok 5\n"} Rmpfr_atan($atan, $b_inv, GMP_RNDN); if($atan - atan($inv) < 0.00001 && $atan - atan($inv) > -0.00001) {print "ok 6\n"} else {print "not ok 6\n"} Rmpfr_sinh($sinh, $b_hangle, GMP_RNDN); if($sinh - sinh($hangle) < 0.00001 && $sinh - sinh($hangle) > -0.00001) {print "ok 7\n"} else {print "not ok 7\n"} Rmpfr_cosh($cosh, $b_hangle, GMP_RNDN); if($cosh - cosh($hangle) < 0.00001 && $cosh - cosh($hangle) > -0.00001) {print "ok 8\n"} else {print "not ok 8\n"} Rmpfr_tanh($tanh, $b_hangle, GMP_RNDN); if($tanh - tanh($hangle) < 0.00001 && $tanh - tanh($hangle) > -0.00001) {print "ok 9\n"} else {print "not ok 9\n"} Rmpfr_asinh($asinh, $b_hinv, GMP_RNDN); if($asinh - asinh($hinv) < 0.00001 && $asinh - asinh($hinv) > -0.00001) {print "ok 10\n"} else {print "not ok 10\n"} Rmpfr_acosh($acosh, $b_hinv, GMP_RNDN); if($acosh - acosh($hinv) < 0.00001 && $acosh - acosh($hinv) > -0.00001) {print "ok 11\n"} else {print "not ok 11\n"} Rmpfr_atanh($atanh, $b_invatanh, GMP_RNDN); if($atanh - atanh($invatanh) < 0.00001 && $atanh - atanh($invatanh) > -0.00001) {print "ok 12\n"} else {print "not ok 12\n"} Rmpfr_sin_cos($sin, $cos, $b_angle, GMP_RNDN); if($sin - sin($angle) < 0.00001 && $sin - sin($angle) > -0.00001 && $cos - cos($angle) < 0.00001 && $cos - cos($angle) > -0.00001) {print "ok 13\n"} else {print "not ok 13\n"} Rmpfr_atan2($atan2,$b_angle2, $b_angle, GMP_RNDN); if($atan2 - atan2($angle2, $angle) < 0.00000001 && $atan2 - atan2($angle2, $angle) > -0.00000001) {print "ok 14\n"} else {print "not ok 14 $atan2 ", atan2($angle2, $angle),"\n"} $angle *= -1; $b_angle *= -1; Rmpfr_atan2($atan2,$b_angle2, $b_angle, GMP_RNDN); if($atan2 - atan2($angle2, $angle) < 0.00000001 && $atan2 - atan2($angle2, $angle) > -0.00000001) {print "ok 15\n"} else {print "not ok 15 $atan2 ", atan2($angle2, $angle),"\n"} # Return $angle and $b_angle to their original values: $angle *= -1; $b_angle *= -1; my $ok = ''; Rmpfr_sec($rop, $b_angle, GMP_RNDN); if($rop - sec($angle) < 0.000000001 && $rop - sec($angle) > -0.000000001) {$ok .= 'a'} Rmpfr_csc($rop, $b_angle, GMP_RNDN); if($rop - csc($angle) < 0.000000001 && $rop - csc($angle) > -0.000000001) {$ok .= 'b'} Rmpfr_cot($rop, $b_angle, GMP_RNDN); if($rop - cot($angle) < 0.000000001 && $rop - cot($angle) > -0.000000001) {$ok .= 'c'} Rmpfr_sech($rop, $b_angle, GMP_RNDN); if($rop - sech($angle) < 0.000000001 && $rop - sech($angle) > -0.000000001) {$ok .= 'd'} Rmpfr_csch($rop, $b_angle, GMP_RNDN); if($rop - csch($angle) < 0.000000001 && $rop - csch($angle) > -0.000000001) {$ok .= 'e'} Rmpfr_coth($rop, $b_angle, GMP_RNDN); if($rop - coth($angle) < 0.000000001 && $rop - coth($angle) > -0.000000001) {$ok .= 'f'} if($ok eq 'abcdef') {print "ok 16\n"} else {print "not ok 16 $ok\n"} $ok = ''; Rmpfr_sinh_cosh($sinh, $cosh, $b_hinv, GMP_RNDN); if($sinh > 1.982318 && $sinh < 1.982319) {$ok .= 'a'} if($cosh > 2.22026726 && $cosh < 2.22026727) {$ok .= 'b'} if($ok eq 'ab') {print "ok 17\n"} else {print "not ok 17 $ok\n"} Math-MPFR-3.32/t/TRmpfr_out_str.t0000644000076400010400000001274212660557734020212 0ustar sisyphusAdministratorsuse warnings; use Math::MPFR qw(:mpfr); print "1..8\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; Rmpfr_set_default_prec(64); $mpfr = Math::MPFR->new(17); open(WR1, '>', 'out1.txt') or die "Can't open WR1: $!"; open(WR2, '>', 'out2.txt') or die "Can't open WR2: $!"; open(WR3, '>', 'out3.txt') or die "Can't open WR3: $!"; open(WR4, '>', 'out4.txt') or die "Can't open WR4: $!"; open(WR5, '>', 'out5.txt') or die "Can't open WR5: $!"; open(WR6, '>', 'out6.txt') or die "Can't open WR6: $!"; open(WR7, '>', 'out7.txt') or die "Can't open WR7: $!"; $prefix = "This is the prefix "; $suffix = " and this is the suffix\n"; # No prefix, no suffix - the five numbers will all be # strung together on the one line. for(1..5) { $ret = TRmpfr_out_str(\*WR1, 10, 0, $mpfr, GMP_RNDN); print WR7 "From the first loop\n"; } # Prefix, but no suffix - again, the output will be # strung together on the one line. for(1..5) { $ret = TRmpfr_out_str($prefix, \*WR2, 10, 0, $mpfr, GMP_RNDN); print WR7 "From the second loop"; } # Suffix, but no prefix - this file will contain 5 lines. for(1..5) { $ret = TRmpfr_out_str(\*WR3, 10, 0, $mpfr, GMP_RNDN, $suffix); print WR7 "\nFrom the third loop"; } print WR7 "\n"; # Both prefix and suffix - this file will contain 5 lines. for(1..5) { $ret = TRmpfr_out_str($prefix, \*WR4, 10, 0, $mpfr, GMP_RNDN, $suffix); print WR7 "From the fourth loop\n"; } $prefix .= "\n"; # Prefix, but no suffix - this file will contain 6 lines. for(1..5) { $ret = TRmpfr_out_str($prefix, \*WR5, 10, 0, $mpfr, GMP_RNDN); print WR7 "From the fifth loop"; } # Both prefix and suffix - this file will contain 10 lines - # the prefix appearing on one line, the number and the suffix # appearing on the next. for(1..5) { $ret = TRmpfr_out_str($prefix, \*WR6, 10, 0, $mpfr, GMP_RNDN, $suffix); print WR7 "From the sixth loop"; } close WR1 or die "Can't close WR1: $!"; close WR2 or die "Can't close WR2: $!"; close WR3 or die "Can't close WR3: $!"; close WR4 or die "Can't close WR4: $!"; close WR5 or die "Can't close WR5: $!"; close WR6 or die "Can't close WR6: $!"; close WR7 or die "Can't close WR7: $!"; open(RD1, '<', 'out1.txt') or die "Can't open RD1: $!"; open(RD2, '<', 'out2.txt') or die "Can't open RD2: $!"; open(RD3, '<', 'out3.txt') or die "Can't open RD3: $!"; open(RD4, '<', 'out4.txt') or die "Can't open RD4: $!"; open(RD5, '<', 'out5.txt') or die "Can't open RD5: $!"; open(RD6, '<', 'out6.txt') or die "Can't open RD6: $!"; open(RD7, '<', 'out7.txt') or die "Can't open RD7: $!"; $ok = 1; $count = 0; while() { $count = $.; chomp; unless($_ eq '1.70000000000000000000e1'x5) {$ok = 0} } if($ok && $count == 1) {print "ok 1\n"} else {print "not ok 1 $ok $count\n"} $ok = 1; $count = 0; while() { $count = $.; chomp; unless($_ eq 'This is the prefix 1.70000000000000000000e1'x5) {$ok = 0} } if($ok && $count == 1) {print "ok 2\n"} else {print "not ok 2 $ok $count\n"} $ok = 1; $count = 0; while() { $count = $.; chomp; unless($_ eq '1.70000000000000000000e1 and this is the suffix') {$ok = 0} } if($ok && $count == 5) {print "ok 3\n"} else {print "not ok 3 $ok $count\n"} $ok = 1; $count = 0; while() { $count = $.; chomp; unless($_ eq 'This is the prefix 1.70000000000000000000e1 and this is the suffix') {$ok = 0} } if($ok && $count == 5) {print "ok 4\n"} else {print "not ok 4 $ok $count\n"} $ok = 1; $count = 0; while() { $count = $.; chomp; if($. == 1) { unless($_ eq 'This is the prefix ') {$ok = 0} } elsif($. == 6) { unless($_ eq '1.70000000000000000000e1') {$ok = 0} } else { unless($_ eq '1.70000000000000000000e1This is the prefix ') {$ok = 0} } } if($ok && $count == 6) {print "ok 5\n"} else {print "not ok 5 $ok $count\n"} $ok = 1; $count = 0; while() { $count = $.; chomp; if($. & 1) { unless($_ eq 'This is the prefix ') {$ok = 0} } else { unless($_ eq '1.70000000000000000000e1 and this is the suffix') {$ok = 0} } } if($ok && $count == 10) {print "ok 6\n"} else {print "not ok 6 $ok $count\n"} $ok = 1; $count = 0; while() { $count = $.; chomp; if($. <= 5 && $. >= 1) { unless($_ eq 'From the first loop') {$ok = 0} } if($. == 6) { unless($_ eq 'From the second loop' x 5) {$ok = 0} } if($. <= 11 && $. >= 7) { unless($_ eq 'From the third loop') {$ok = 0} } if($. <= 16 && $. >= 12) { unless($_ eq 'From the fourth loop') {$ok = 0} } if($. == 17) { unless($_ eq 'From the fifth loop' x 5 . 'From the sixth loop' x 5) {$ok = 0} } } if($ok && $count == 17) {print "ok 7\n"} else {print "not ok 7 $ok $count\n"} close RD1 or die "Can't close RD1: $!"; close RD2 or die "Can't close RD2: $!"; close RD3 or die "Can't close RD3: $!"; close RD4 or die "Can't close RD4: $!"; close RD5 or die "Can't close RD5: $!"; close RD6 or die "Can't close RD6: $!"; close RD7 or die "Can't close RD7: $!"; open(WR8, '>', 'out1.txt') or die "Can't open WR8: $!"; print WR8 "1.5e2\n"; close WR8 or die "Can't close WR8: $!"; open(RD8, '<', 'out1.txt') or die "Can't open RD8: $!"; $ret = TRmpfr_inp_str($mpfr, \*RD8, 10, GMP_RNDN); close RD8 or die "Can't close RD8: $!"; if($ret == 5 && $mpfr == 150) {print "ok 8\n"} else {print "not ok 8 $ret $mpfr\n"} Math-MPFR-3.32/t/use64bitint.t0000644000076400010400000002122612660557734017376 0ustar sisyphusAdministrators# Contrary to its name, this script is concerned not so much with 64-bit IV/UV, # more with IV/UV being a'long long int' (or not). use warnings; use strict; use Math::MPFR qw(:mpfr); use Config; #use Devel::Peek; print "1..7\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; my $_64 = Math::MPFR::_has_longlong(); if($_64){warn "long long int support detected\n"} else {warn "long long int support is absent\n"} Rmpfr_set_default_prec(300); my $ok = ''; if($_64) { use integer; my $pp1; my $int1 = Math::MPFR->new(2 ** 57 + 12345); $int1 *= -1; if($int1 == -144115188075868217 && $int1 == "-144115188075868217" ) {$ok = 'a'} if($Config::Config{cc} eq 'cl') { $pp1 = Rmpfr_integer_string($int1, 10, GMP_RNDN); } else {$pp1 = Rmpfr_get_sj($int1, GMP_RNDN)} if($pp1 == -144115188075868217) {$ok .= 'b'} $pp1 += 14; my $int2 = Rmpfr_init(); if($Config::Config{cc} eq 'cl') { Rmpfr_set_str($int2, $pp1, 10, GMP_RNDN); } else {Rmpfr_set_sj($int2, $pp1, GMP_RNDN)} if($int2 == $pp1 && $int2 - $int1 - 14 == 0 && !($int2 - $int1 - 14) ) {$ok .= 'c'} if($Config::Config{cc} eq 'cl') { eval{Rmpfr_set_sj_2exp($int2, $pp1, 2, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/ && $@ !~ /\- use/) {$ok .= 'd'} else {print $@, "\n"} eval{Rmpfr_set_uj_2exp($int2, $pp1, 2, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/ && $@ !~ /\- use/) {$ok .= 'e'} else {print $@, "\n"} } else { Rmpfr_set_sj_2exp($int2, $pp1, 2, GMP_RNDN); if($int2 == $pp1 * 4) {$ok .= 'de'} } if($ok eq 'abcde') {print "ok 1\n"} else {print "not ok 1 $ok\n"} } $ok = ''; if($_64) { my $int3 = Rmpfr_init(); my $pp2 = 2 ** 57 + 12345; $pp2 *= -1; if(Math::MPFR::_itsa($pp2) == 2) {$ok = 'AB'} else { if($Config::Config{cc} eq 'cl') {$ok = 'ab'} # Skip else { Rmpfr_set_sj($int3, ~0, GMP_RNDN); if($int3 == -1) {$ok = 'a'} Rmpfr_set_sj_2exp($int3, ~0, 2, GMP_RNDN); if($int3 == -4) {$ok .= 'b'} } } if(lc($ok) eq 'ab') {print "ok 2\n"} else {print "not ok 2 $ok\n"} } $ok = ''; if($_64) { my ($int, $discard) = Rmpfr_init_set_ui(2, GMP_RNDN); my $pint = -144115188075868217; if(Math::MPFR::_itsa($pint) == 2) {$ok .= 'a'} $int *= $pint; if($int == -288230376151736434 && $int <= -288230376151736434 && $int >= -288230376151736434 && ($int <=> -288230376151736434) == 0 && ($int <=> -288230376151736435) == 1 && $int != -288230376151736435 ) {$ok .= 'b'} $int += $pint; if($int == -432345564227604651 && ($int <=> -432345564227604651) == 0 && ($int <=> -432345564227604649) == -1 && $int != -432345564227604653 ) {$ok .= 'c'} $int -= $pint; if($int == -288230376151736434 && $int == "-288230376151736434" && ($int <=> -288230376151736434) == 0 && ($int <=> -288230376151736435) == 1 && $int != -288230376151736435 ) {$ok .= 'd'} $int += 12345; $int /= $pint; # $int is no longer an integer value if($int < 2 && $int > 1.99 && $int > "1.99" && $int <= 2 && $int >= 1.99 && ($int <=> 1.99) == 1 && ($int <=> 2) == -1 ) {$ok .= 'e'} ##################################### $int = 2; my $temp = Math::MPFR->new(); $temp = $int * $pint; if(!($] < 5.007 && !Math::MPFR::_has_longdouble() && Math::MPFR::_has_longlong())) { if($temp == -288230376151736434 && $temp != -288230376151736435 ) {$ok .= 'f'} $temp = $temp + $pint; if($temp == -432345564227604651 && $temp != -432345564227604653 ) {$ok .= 'g'} $temp = $temp - $pint; if($temp == -288230376151736434 && $temp != -288230376151736435 ) {$ok .= 'h'} } else { warn "Skipping tests 3f to 3h as they fail on perl 5.6\nbuilt with -Duse64bitint but without -Duselongdouble\n"; $ok .= 'fgh'; } ##################################### $temp = $temp + 12345; $temp = $temp / $pint; # $temp no longer an integer value if($temp < 2 && $temp > 1.99 && $temp <= 2 && $temp <= "2" && $temp >+ 1.99 ) {$ok .= 'i'} $pint *= -1; $temp = atan2(99999, $pint); if($temp > 6.938824e-13 && $temp < 6.938825e-13 && $temp >= 6.938824e-13 && $temp <= 6.938825e-13 && ($temp <=> 6.938825e-13) == -1 && ($temp <=> 6.938824e-13) == 1 ) {$ok .= 'j'} if($int) {$ok .= 'k'} $int *= 0; if(!$int) {$ok.= 'l'} my $temp2 = Math::MPFR->new($pint); my $pint2; if($Config::Config{cc} eq 'cl') { $pint2 = Rmpfr_integer_string($temp2, 10, GMP_RNDN); } else {$pint2 = Rmpfr_get_sj($temp2, GMP_RNDN)} if(!($] < 5.007 && !Math::MPFR::_has_longdouble() && Math::MPFR::_has_longlong())) { if($pint2 == $pint && $pint2 < $pint + 1 && $pint2 > $pint - 1 ) {$ok .= 'm'} } else { warn "Skipping test 3m as it fails on perl 5.6\nbuilt with -Duse64bitint but without -Duselongdouble\n"; $ok .= 'm'; } my $temp3 = new Math::MPFR($pint); if($temp3 == $temp2) {$ok .= 'n'} if($ok eq 'abcdefghijklmn') {print "ok 3\n"} else {print "not ok 3 $ok\n"} } $ok = ''; if($_64) { my $int3 = Math::MPFR->new(); if($Config::Config{cc} eq 'cl') { eval{Rmpfr_set_sj($int3, ~0, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl \- use/) {$ok = 'a'} eval{Rmpfr_set_uj($int3, ~0, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl \- use/) {$ok .= 'b'} eval{Rmpfr_get_sj($int3, GMP_RNDN);}; if(!$@) {$ok .= 'c'} eval{Rmpfr_get_uj($int3, GMP_RNDN);}; if(!$@) {$ok .= 'd'} if($ok eq 'abcd') {print "ok 4\n"} else {print "not ok $ok\n"} } else { warn "Skipping test 4 - 'cl' compiler not used\n"; print "ok 4\n"; } } $ok = ''; if(!$_64) { my $int1 = Math::MPFR->new(); eval{Rmpfr_set_uj_2exp($int1, 2 ** 23, 2, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i && $@ !~ /\- use/) {$ok .= 'a'} else {print $@, "\n"} eval{Rmpfr_set_sj_2exp($int1, 2 ** 23, 2, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i && $@ !~ /\- use/) {$ok .= 'b'} else {print $@, "\n"} if($ok eq 'ab') {print "ok 1\n"} else {print "not ok 1 $ok\n"} $ok = ''; eval{Rmpfr_get_sj($int1, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i && $@ !~ /\- use/) {$ok .= 'a'} else {print $@, "\n"} eval{Rmpfr_get_uj($int1, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i && $@ !~ /\- use/) {$ok .= 'b'} else {print $@, "\n"} if($ok eq 'ab') {print "ok 2\n"} else {print "not ok 2 $ok\n"} $ok = ''; eval{Rmpfr_set_sj($int1, 42, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i && $@ !~ /\- use/) {$ok .= 'a'} else {print $@, "\n"} eval{Rmpfr_set_uj($int1, 42, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i && $@ !~ /\- use/) {$ok .= 'b'} else {print $@, "\n"} if($ok eq 'ab') {print "ok 3\n"} else {print "not ok 3 $ok\n"} warn "Skipping test 4 - nothing to test\n"; print "ok 4\n"; } my $bits = $Config{ivsize} * 8; my ($uhigh, $uhigh1, $uhigh2); { use integer; my $temp = (2 ** ($bits - 2)) - 1; $uhigh = (2 * $temp) + 1; #$uhigh = (2 ** $bits) - 1; } $uhigh = (2 * $uhigh) + 1; #Dump($uhigh); $uhigh1 = Math::MPFR->new($uhigh); $uhigh2 = Rmpfr_init(); if(Math::MPFR::_has_longlong()) { Rmpfr_set_uj($uhigh2, $uhigh, GMP_RNDN); } else { Rmpfr_set_ui($uhigh2, $uhigh, GMP_RNDN); } if($] < 5.007 && !Math::MPFR::_has_longdouble() && Math::MPFR::_has_longlong()) { warn "Skipping tests 5 and 6 as they fail on perl 5.6\nbuilt with -Duse64bitint but without -Duselongdouble\n"; print "ok 5\n"; print "ok 6\n"; } else { if(!Rmpfr_cmp($uhigh1, $uhigh2)) {print "ok 5\n"} else { warn "\n\$uhigh1: $uhigh1\n\$uhigh2: $uhigh2\n"; print "not ok 5\n"; } if(Math::MPFR::_has_longlong()) { # No mpfr_cmp_uj() yet available if(!Rmpfr_cmp($uhigh1, Math::MPFR->new($uhigh))) {print "ok 6\n"} else { warn "\n\$uhigh1: $uhigh1\n\$uhigh: ", Math::MPFR->new($uhigh), "\n"; print "not ok 6\n"; } } else { if(!Rmpfr_cmp_ui($uhigh1, $uhigh)) {print "ok 6\n"} else { warn "\n\$uhigh1: $uhigh1\n\$uhigh: $uhigh\n"; print "not ok 6\n"; } } } if(Math::MPFR::_has_longlong()) { # No mpfr_cmp_uj() yet available if(!Rmpfr_cmp($uhigh2, Math::MPFR->new($uhigh))) {print "ok 7\n"} else { warn "\n\$uhigh2: $uhigh2\n\$uhigh: $uhigh\n"; print "not ok 7\n"; } } else { if(!Rmpfr_cmp_ui($uhigh2, $uhigh)) {print "ok 7\n"} else { warn "\n\$uhigh2: $uhigh2\n\$uhigh: $uhigh\n"; print "not ok 7\n"; } } Math-MPFR-3.32/t/uselongdouble.t0000644000076400010400000001740212660557734020066 0ustar sisyphusAdministratorsuse strict; use warnings; use Math::MPFR qw(:mpfr); use Config; print "1..9\n"; print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; if(Math::MPFR::_has_longdouble()) {print "Using long double\n"} else {print "Not using long double\n"} Rmpfr_set_default_prec(300); if(Math::MPFR::_has_longdouble()) { my $ok = ''; my $n = (2 ** 55) + 0.5; my $ld1 = Math::MPFR->new($n); my $ld2 = Math::MPFR::new($n); my $ld3 = Math::MPFR->new(); Rmpfr_set_ld($ld3, $n, GMP_RNDN); if( $ld1 == $ld2 && $ld2 == $ld3 && $ld2 <= $n && $ld2 >= $n && $ld2 < $n + 1 && $ld2 > $n - 1 && ($ld2 <=> $n) == 0 && ($ld2 <=> $n - 1) > 0 && ($ld2 <=> $n + 1) < 0 && $ld2 != $n - 1 ) {$ok .= 'a'} my $d2 = Rmpfr_get_ld($ld1, GMP_RNDN); if($d2 == $n) {$ok .= 'b'} if(!Rmpfr_cmp_ld($ld1, $n)) {$ok .= 'c'} if($ok eq 'abc') {print "ok 1\n"} else {print "not ok 1 $ok\n"} $ok = ''; # Check the overloaded operators. if($ld1 - 1 == $n - 1) {$ok .= 'a'} $ld1 -= 1; if($ld1 == $n - 1) {$ok .= 'b'} $ld1 = $ld1 / 2; if($ld1 == ($n - 1) / 2) {$ok .= 'c'} $ld1 = $ld1 * 2; if($ld1 == $n - 1) {$ok .= 'd'} $ld1 /= 2; if($ld1 == ($n - 1) / 2) {$ok .= 'e'} $ld1 *= 2; if($ld1 == $n - 1) {$ok .= 'f'} if($ld1 + 1 == $n) {$ok .= 'g'} $ld1 += 1; if($ld1 == $n) {$ok .= 'h'} if($ld1 ** 0.5 < 189812531.25 && $ld1 ** 0.5 > 189812531.24) {$ok .= 'i'} $ld1 **= 0.5; if($ld1 < 189812531.25 && $ld1 > 189812531.24) {$ok .= 'j'} if($ok eq 'abcdefghij') {print "ok 2\n"} else {print "not ok 2 $ok\n"} my $bits = $Config::Config{longdblsize} > $Config::Config{doublesize} ? $Config::Config{doublesize} * 7 : 50; $n = (2 ** $bits) + 0.5; my $ld4 = Math::MPFR->new($n); if($ld4 == int($ld4)) { print "not ok 3 precision has been lost: $ld4\n"} else {print "ok 3\n"} } else { my $ok = ''; my $int1 = Rmpfr_init(); eval{Rmpfr_set_ld($int1, 2 ** 23, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i) {$ok = 'a'} eval{Rmpfr_cmp_ld($int1, 2 ** 23);}; if($@ =~ /not implemented on this build of perl/i) {$ok .= 'b'} eval{Rmpfr_get_ld($int1, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i) {$ok .= 'c'} eval{my($int2, $ret) = Rmpfr_init_set_ld(2 ** 23, GMP_RNDN);}; if($@ =~ /not implemented on this build of perl/i) {$ok .= 'd'} if($ok eq 'abcd') {print "ok 1\n"} else {print "not ok 1 $ok\n"} warn "Skipping test 2 - nothing to test\n"; print "ok 2\n"; warn "Skipping test 3 - nothing to test\n"; print "ok 3\n"; } if(Math::MPFR::_has_longdouble()) { my $mpfr = Math::MPFR->new('1' x 62, 2); my $mpfr2 = Rmpfr_init(); my $ok = ''; if ($mpfr < 4611686018427387904 && $mpfr > 4611686018427387902) {$ok .= 'a'} if ($mpfr <= 4611686018427387904 && $mpfr >= 4611686018427387902) {$ok .= 'b'} if ($mpfr == 4611686018427387903) {$ok .= 'c'} if ($mpfr <= 4611686018427387903) {$ok .= 'd'} if ($mpfr >= 4611686018427387903) {$ok .= 'e'} my $ld = Rmpfr_get_ld($mpfr, GMP_RNDN); if ($ld < 4611686018427387904 && $ld > 4611686018427387902) {$ok .= 'f'} if ($ld == 4611686018427387903) {$ok .= 'g'} my $cmp = $mpfr <=> 4611686018427387902; if($cmp > 0) {$ok .= 'h'} $cmp = $mpfr <=> 4611686018427387903; if($cmp == 0) {$ok .= 'i'} $cmp = $mpfr <=> 4611686018427387904; if($cmp < 0) {$ok .= 'j'} $cmp = 4611686018427387902 <=> $mpfr; if($cmp < 0) {$ok .= 'k'} $cmp = 4611686018427387903 <=> $mpfr; if($cmp == 0) {$ok .= 'l'} $cmp = 4611686018427387904 <=> $mpfr; if($cmp > 0) {$ok .= 'm'} Rmpfr_set_ld($mpfr2, 4611686018427387903, GMP_RNDN); if($mpfr2 == $mpfr) {$ok .= 'n'} if($ok eq 'abcdefghijklmn') {print "ok 4\n"} else {print "not ok 4 $ok\n"} } else { warn "Skipping test 4 - no long double support\n"; print "ok 4\n"; } my $num1 = Math::MPFR->new(100); my $exp = \$num1; if(Math::MPFR::_has_longdouble()) { my $double = Rmpfr_get_ld_2exp($exp, $num1, GMP_RNDN); if($double > 0.781249 && $double < 0.781251 && $exp == 7) {print "ok 5\n"} else { warn "\n Got (double): $double\n Expected: 0.78125\n\n", " Got (exp): $exp\n Expected: 7\n"; print "not ok 5\n"; } } else { eval{my $double = Rmpfr_get_ld_2exp($exp, $num1, GMP_RNDN);}; if($@ =~ /Rmpfr_get_ld_2exp not implemented/) {print "ok 5\n"} else { warn "\n\$\@: $@\n"; print "not ok 5\n"; } } if(Math::MPFR::_has_longdouble()) { my $double = (2 ** 55) + 0.5; if($double == Rmpfr_get_NV(Math::MPFR->new($double), GMP_RNDN)) {print "ok 6\n"} else { warn "\nGot: ", Rmpfr_get_NV(Math::MPFR->new($double), GMP_RNDN) , "\nExpected: $double\n"; print "not ok 43\n"; } } else { warn "Skipping test 6 - no long double support\n"; print "ok 6\n"; } if(Math::MPFR::_has_longdouble()) { my $nan = Math::MPFR->new(); my $posinf = Math::MPFR->new('inf'); my $neginf = Math::MPFR->new('-inf'); my $ok = ''; if($posinf == - $neginf) {$ok .= 'a'} else {warn "a: $posinf ", $neginf * -1, "\n"} my $double = Rmpfr_get_ld($nan, GMP_RNDN); Rmpfr_set_ld($nan, $double, GMP_RNDN); if(Rmpfr_nan_p($nan)) {$ok .= 'b'} else {warn "b: $nan\n"} $double = Rmpfr_get_ld($posinf, GMP_RNDN); Rmpfr_set_ld($posinf, $double, GMP_RNDN); if(Rmpfr_inf_p($posinf) && $posinf > 0) {$ok .= 'c'} else {warn "c: $posinf\n"} $double = Rmpfr_get_ld($neginf, GMP_RNDN); Rmpfr_set_ld($neginf, $double, GMP_RNDN); if(Rmpfr_inf_p($neginf) && $neginf < 0) {$ok .= 'd'} else {warn "d: $neginf\n"} $double = Rmpfr_get_NV($nan, GMP_RNDN); Rmpfr_set_ld($nan, $double, GMP_RNDN); if(Rmpfr_nan_p($nan)) {$ok .= 'e'} else {warn "e: $nan\n"} $double = Rmpfr_get_NV($posinf, GMP_RNDN); Rmpfr_set_ld($posinf, $double, GMP_RNDN); if(Rmpfr_inf_p($posinf) && $posinf > 0) {$ok .= 'f'} else {warn "f: $posinf\n"} $double = Rmpfr_get_NV($neginf, GMP_RNDN); Rmpfr_set_ld($neginf, $double, GMP_RNDN); if(Rmpfr_inf_p($neginf) && $neginf < 0) {$ok .= 'g'} else {warn "g: $neginf\n"} if($ok eq 'abcdefg') {print "ok 7\n"} else {print "not ok 7 $ok\n"} } else { warn "Skipping test 7 - no long double support\n"; print "ok 7\n"; } if(Math::MPFR::_has_longdouble()) { # Check that the mpfr_get_ld() bug has been fixed (mpfr-2.4.2 and later only) if(MPFR_VERSION > 132097) { my $prec = Rmpfr_get_default_prec(); Rmpfr_set_default_prec(64); my $bugtest = Math::MPFR->new(-12345); Rmpfr_exp($bugtest, $bugtest, GMP_RNDN); my $ld = Rmpfr_get_ld($bugtest, GMP_RNDN); Rmpfr_set_default_prec($prec); if($ld < 0.000000001 && $ld >= 0){print "ok 8\n"} else { warn "Got: $ld\n"; print "not ok 8\n"; } } else { warn "Skipping test 8 - mpfr_get_ld bug with mpfr-2.4.1 and earlier will cause the test to fail\n"; print "ok 8\n"; } } else { warn "Skipping test 8 - no long double support\n"; print "ok 8\n"; } # Test for a bug that affects Double-Double type only. if(Math::MPFR::_has_longdouble()) { my $prob1 = Rmpfr_init2(2097); my $prob2 = Rmpfr_init2(2098); my $p_val = (2 ** 1023) + (2 ** -1074); my $res = $p_val > 2 ** 1023 ? 1 : 0; my $res1 = Rmpfr_set_ld($prob1, $p_val, MPFR_RNDN); my $res2 = Rmpfr_set_ld($prob2, $p_val, MPFR_RNDN); if($res) { # double-double if($res1 == -1 && $res2 == 0) { print "ok 9\n"; } else { warn "\nDouble-Double type: \$res1: $res1 \$res2: $res2\n"; print "not ok 9\n"; } } else { if(!$res1 && !$res2) { print "ok 9\n"; } else { warn "\nNOT Double-Double type: \$res1: $res1 \$res2: $res2\n"; print "not ok 9\n"; } } } else { warn "Skipping test 9 - no long double support\n"; print "ok 9\n"; } Math-MPFR-3.32/t/_1aaa_v.t0000644000076400010400000000276512660557734016514 0ustar sisyphusAdministratorsuse warnings; use strict; print "1..1\n"; eval {use Math::MPFR::V;}; if($@) { warn "\$\@: $@"; print "not ok 1\n"; } else { warn "\nGMP Header version (major): ", Math::MPFR::V::___GNU_MP_VERSION(), "\n"; warn "GMP Header version (minor): ", Math::MPFR::V::___GNU_MP_VERSION_MINOR(), "\n"; warn "GMP Header version (patchlevel): ", Math::MPFR::V::___GNU_MP_VERSION_PATCHLEVEL(), "\n"; warn "GMP Library version: ", Math::MPFR::V::gmp_v(), "\n"; warn "GMP CC: ", Math::MPFR::V::___GMP_CC(), "\n"; warn "GMP CFLAGS: ", Math::MPFR::V::___GMP_CFLAGS(), "\n"; warn "MPFR Header version (major): ", Math::MPFR::V::_MPFR_VERSION_MAJOR(), "\n"; warn "MPFR Header version (minor): ", Math::MPFR::V::_MPFR_VERSION_MINOR(), "\n"; warn "MPFR Header version (patchlevel): ", Math::MPFR::V::_MPFR_VERSION_PATCHLEVEL(), "\n"; warn "MPFR Library version: ", Math::MPFR::V::Rmpfr_get_version(), "\n"; print "ok 1\n"; } my($h_major, $h_minor) = (Math::MPFR::V::_MPFR_VERSION_MAJOR(), Math::MPFR::V::_MPFR_VERSION_MINOR()); if(($h_major < 2) || ($h_major == 2 && $h_minor < 4)) { warn "\n\n Your MPFR Header version is outdated and unsupported.\n", " REMAINING TEST SUITE WILL POSSIBLY FAIL !!!!\n"; } my @lv = split /\./, Math::MPFR::V::Rmpfr_get_version(); #warn "$lv[0] $lv[1]\n"; if(($lv[0] < 2) || ($lv[0] == 2 && $lv[1] < 4)) { warn "\n\n Your MPFR Library version is outdated and unsupported.\n", " REMAINING TEST SUITE SHOULD INEVITABLY FAIL !!!!\n"; } Math-MPFR-3.32/t/_1basic.t0000644000076400010400000000470312660557734016520 0ustar sisyphusAdministratorsuse warnings; use strict; use Config; use Math::MPFR qw(:mpfr); use Math::MPFR::V; print "1..8\n"; warn "\n# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n"; warn "# Using mpfr library version ", MPFR_VERSION_STRING, "\n"; warn "# Using gmp library version ", Math::MPFR::gmp_v(), "\n"; warn "# GMP_LIMB_BITS is ", Math::MPFR::_GMP_LIMB_BITS, "\n" if defined Math::MPFR::_GMP_LIMB_BITS; warn "# GMP_NAIL_BITS is ", Math::MPFR::_GMP_NAIL_BITS, "\n" if defined Math::MPFR::_GMP_NAIL_BITS; if (pack("L", 305419897) eq pack("N", 305419897)) {warn "# Machine appears to be big-endian\n"} elsif(pack("L", 305419897) eq pack("V", 305419897)) {warn "# Machine appears to be little-endian\n"} warn "# Byte Order: ", $Config{byteorder}, "\n"; if($Math::MPFR::VERSION eq '3.32') {print "ok 1\n"} else {print "not ok 1 $Math::MPFR::VERSION\n"} if(Math::MPFR::_get_xs_version() eq '3.32') {print "ok 2\n"} else { warn "Module version: $Math::MPFR::VERSION\nXS version: ", Math::MPFR::_get_xs_version(), "\n"; print "not ok 2\n"; } if(Rmpfr_get_version() eq MPFR_VERSION_STRING) {print "ok 3\n"} else {print "not ok 3 - Header and Library do not match\n"} my $max_base = Math::MPFR::_max_base(); if($max_base == 62) { if(3 <= MPFR_VERSION_MAJOR) {print "ok 4\n"} else { warn "\n\$max_base: $max_base\n"; warn "VERSION_MAJOR ", MPFR_VERSION_MAJOR, "\n"; print "not ok 4\n"; } } elsif($max_base == 36) { if(3 > MPFR_VERSION_MAJOR) {print "ok 4\n"} else { warn "\n\$max_base: $max_base\n"; warn "VERSION_MAJOR ", MPFR_VERSION_MAJOR, "\n"; print "not ok 4\n"; } } else { warn "\n\$max_base: $max_base\n"; print "not ok 4\n"; } if(Math::MPFR::_has_longlong() && Math::MPFR::_ivsize_bits() == (8 * $Config{ivsize})) {print "ok 5\n"} elsif(!Math::MPFR::_has_longlong()) {print "ok 5\n"} else { warn "\n _has_longlong(): ", Math::MPFR::_has_longlong(), "\n _ivsize_bits: ", Math::MPFR::_ivsize_bits(), "\n"; print "not ok 5\n"; } if($Math::MPFR::VERSION eq $Math::MPFR::Random::VERSION) {print "ok 6\n"} else { warn "\$Math::MPFR::Random::VERSION: $Math::MPFR::Random::VERSION \n"; print "not ok 6\n"; } if($Math::MPFR::VERSION eq $Math::MPFR::Prec::VERSION) {print "ok 7\n"} else { warn "\$Math::MPFR::Prec::VERSION: $Math::MPFR::Prec::VERSION \n"; print "not ok 7\n"; } if($Math::MPFR::VERSION eq $Math::MPFR::V::VERSION) {print "ok 8\n"} else { warn "\$Math::MPFR::V::VERSION: $Math::MPFR::V::VERSION \n"; print "not ok 8\n"; } Math-MPFR-3.32/t/_2exp.t0000644000076400010400000001335412660557734016236 0ustar sisyphusAdministratorsuse warnings; use strict; use Math::MPFR qw(:mpfr); #use Devel::Peek; print "1..3\n"; my ($exp, $ret); my $rop = Math::MPFR->new(); my $op1 = Math::MPFR->new(64.75); my $op2 = Math::MPFR->new(0.25); my $nan = Math::MPFR->new(); my $zero = Math::MPFR->new(0); my $unity = Math::MPFR->new(1); my $inf = $unity / $zero; my $ninf = -($inf); my $nzero = $zero * -1; my $ok = ''; if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) { $ret = Rmpfr_frexp($exp, $rop, $op1, GMP_RNDN); if($ret == 0 && $exp == 7 && $rop == 0.505859375) {$ok .= 'a'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, $op2, GMP_RNDN); if($ret == 0 && $exp == -1 && $rop == 0.5) {$ok .= 'b'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, -$op1, GMP_RNDN); if($ret == 0 && $exp == 7 && $rop == -0.505859375) {$ok .= 'c'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, -$op2, GMP_RNDN); if($ret == 0 && $exp == -1 && $rop == -0.5) {$ok .= 'd'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, $zero, GMP_RNDN); if($ret == 0 && $exp == 0 && $rop == 0 && Rmpfr_sgn($rop) == 0 && !Rmpfr_signbit($rop)) {$ok .= 'e'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, $nzero, GMP_RNDN); if($ret == 0 && $exp == 0 && $rop == 0 && !Rmpfr_sgn($rop) && Rmpfr_signbit($rop)) {$ok .= 'f'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, $nan, GMP_RNDN); if($ret == 0 && Rmpfr_nan_p($rop)) {$ok .= 'g'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, $inf, GMP_RNDN); if($ret == 0 && Rmpfr_inf_p($rop) && !Rmpfr_signbit($rop)) {$ok .= 'h'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; $ret = Rmpfr_frexp($exp, $rop, $ninf, GMP_RNDN); if($ret == 0 && Rmpfr_inf_p($rop) && Rmpfr_signbit($rop)) {$ok .= 'i'} #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n"; if($ok eq 'abcdefghi') {print "ok 1\n"} else { warn "1: \$ok: $ok\n"; print "not ok 1\n"; } } else { eval{Rmpfr_frexp($exp, $rop, $op1, GMP_RNDN);}; if($@ =~ /Rmpfr_frexp not implemented/) {print "ok 1\n"} else { warn "\$\@: $@"; print "not ok 1\n"; } } $ok = ''; $ret = Rmpfr_get_d_2exp($exp, $op1, GMP_RNDN); if($exp == 7 && $ret == 0.505859375) {$ok .= 'a'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, $op2, GMP_RNDN); if($exp == -1 && $ret == 0.5) {$ok .= 'b'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, -$op1, GMP_RNDN); if($exp == 7 && $ret == -0.505859375) {$ok .= 'c'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, -$op2, GMP_RNDN); if($exp == -1 && $ret == -0.5) {$ok .= 'd'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, $zero, GMP_RNDN); if($exp == 0 && is_pzero($ret)) {$ok .= 'e'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, $nzero, GMP_RNDN); if($exp == 0 && is_nzero($ret)) {$ok .= 'f'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, $nan, GMP_RNDN); if(is_nan($ret)) {$ok .= 'g'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, $inf, GMP_RNDN); if(is_pinf($ret)) {$ok .= 'h'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_d_2exp($exp, $ninf, GMP_RNDN); if(is_ninf($ret)) {$ok .= 'i'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; if($ok eq 'abcdefghi') {print "ok 2\n"} else { warn "2: \$ok: $ok\n"; print "not ok 2\n"; } $ok = ''; if(Math::MPFR::_has_longdouble()) { $ret = Rmpfr_get_ld_2exp($exp, $op1, GMP_RNDN); if($exp == 7 && $ret == 0.505859375) {$ok .= 'a'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, $op2, GMP_RNDN); if($exp == -1 && $ret == 0.5) {$ok .= 'b'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, -$op1, GMP_RNDN); if($exp == 7 && $ret == -0.505859375) {$ok .= 'c'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, -$op2, GMP_RNDN); if($exp == -1 && $ret == -0.5) {$ok .= 'd'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, $zero, GMP_RNDN); if($exp == 0 && is_pzero($ret)) {$ok .= 'e'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, $nzero, GMP_RNDN); if($exp == 0 && is_nzero($ret)) {$ok .= 'f'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, $nan, GMP_RNDN); if(is_nan($ret)) {$ok .= 'g'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, $inf, GMP_RNDN); if(is_pinf($ret)) {$ok .= 'h'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; $ret = Rmpfr_get_ld_2exp($exp, $ninf, GMP_RNDN); if(is_ninf($ret)) {$ok .= 'i'} #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n"; if($ok eq 'abcdefghi') {print "ok 3\n"} else { warn "3: \$ok: $ok\n"; print "not ok 3\n"; } } else { warn "Skipping test 3 - no long double support\n"; print "ok 3\n"; } sub is_nan { return Rmpfr_nan_p(Math::MPFR->new($_[0])); } sub is_pinf { my $x = Math::MPFR->new($_[0]); if(Rmpfr_inf_p($x) && !Rmpfr_signbit($x)) {return 1} return 0; } sub is_ninf { my $x = Math::MPFR->new($_[0]); if(Rmpfr_inf_p($x) && Rmpfr_signbit($x)) {return 1} return 0; } sub is_pzero { my $x = Math::MPFR->new($_[0]); if(Rmpfr_zero_p($x) && !Rmpfr_signbit($x)) {return 1} return 0; } sub is_nzero { my $x = Math::MPFR->new($_[0]); if(Rmpfr_zero_p($x) && Rmpfr_signbit($x)) {return 1} return 0; } Math-MPFR-3.32/typemap0000644000076400010400000000061312660557734016165 0ustar sisyphusAdministratorsmpq_t * MPQ mpz_t * MPZ mpf_t * MPF mpfr_t * MPFR gmp_randstate_t * GMP_RANDSTATE INPUT MPQ $var = INT2PTR($type, SvIV(SvRV($arg))); MPZ $var = INT2PTR($type, SvIV(SvRV($arg))); MPF $var = INT2PTR($type, SvIV(SvRV($arg))); MPFR $var = INT2PTR($type, SvIV(SvRV($arg))); GMP_RANDSTATE $var = INT2PTR($type, SvIV(SvRV($arg))); Math-MPFR-3.32/V/0000755000076400010400000000000012660557757014775 5ustar sisyphusAdministratorsMath-MPFR-3.32/V/Makefile.PL0000644000076400010400000000040412660557734016740 0ustar sisyphusAdministratorsuse ExtUtils::MakeMaker; my %options = %{ { 'NAME' => 'Math::MPFR::V', 'LIBS' => $LIBS, 'INC' => $INC, 'VERSION_FROM' => 'V.pm' } }; WriteMakefile(%options); # Remove the Makefile dependency. Causes problems on a few systems. sub MY::makefile { '' } Math-MPFR-3.32/V/V.pm0000644000076400010400000000076312660557734015541 0ustar sisyphusAdministrators## This file generated by InlineX::C2XS (version 0.24) using Inline::C (version 0.73) # Provides access to some gmp and mpfr macros/constants package Math::MPFR::V; use strict; use warnings; require Exporter; *import = \&Exporter::import; require DynaLoader; our $VERSION = '3.32'; #$VERSION = eval $VERSION; DynaLoader::bootstrap Math::MPFR::V $VERSION; @Math::MPFR::V::EXPORT = (); @Math::MPFR::V::EXPORT_OK = (); sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking 1; Math-MPFR-3.32/V/V.xs0000644000076400010400000000502412660557734015552 0ustar sisyphusAdministrators #ifdef __MINGW32__ #ifndef __USE_MINGW_ANSI_STDIO #define __USE_MINGW_ANSI_STDIO 1 #endif #endif #define PERL_NO_GET_CONTEXT 1 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include SV * ___GNU_MP_VERSION(pTHX) { return newSVuv(__GNU_MP_VERSION); } SV * ___GNU_MP_VERSION_MINOR(pTHX) { return newSVuv(__GNU_MP_VERSION_MINOR); } SV * ___GNU_MP_VERSION_PATCHLEVEL(pTHX) { return newSVuv(__GNU_MP_VERSION_PATCHLEVEL); } SV * ___GMP_CC(pTHX) { #ifdef __GMP_CC char * ret = __GMP_CC; return newSVpv(ret, 0); #else return &PL_sv_undef; #endif } SV * ___GMP_CFLAGS(pTHX) { #ifdef __GMP_CFLAGS char * ret = __GMP_CFLAGS; return newSVpv(ret, 0); #else return &PL_sv_undef; #endif } SV * gmp_v(pTHX) { #if __GNU_MP_VERSION >= 4 return newSVpv(gmp_version, 0); #else warn("From Math::MPFR::V::gmp_v function: 'gmp_version' is not implemented - returning '0'"); return newSVpv("0", 0); #endif } SV * _MPFR_VERSION(pTHX) { return newSVuv(MPFR_VERSION); } SV * _MPFR_VERSION_MAJOR(pTHX) { return newSVuv(MPFR_VERSION_MAJOR); } SV * _MPFR_VERSION_MINOR(pTHX) { return newSVuv(MPFR_VERSION_MINOR); } SV * _MPFR_VERSION_PATCHLEVEL(pTHX) { return newSVuv(MPFR_VERSION_PATCHLEVEL); } SV * _MPFR_VERSION_STRING(pTHX) { return newSVpv(MPFR_VERSION_STRING, 0); } SV * Rmpfr_get_version(pTHX) { return newSVpv(mpfr_get_version(), 0); } MODULE = Math::MPFR::V PACKAGE = Math::MPFR::V PROTOTYPES: DISABLE SV * ___GNU_MP_VERSION () CODE: RETVAL = ___GNU_MP_VERSION (aTHX); OUTPUT: RETVAL SV * ___GNU_MP_VERSION_MINOR () CODE: RETVAL = ___GNU_MP_VERSION_MINOR (aTHX); OUTPUT: RETVAL SV * ___GNU_MP_VERSION_PATCHLEVEL () CODE: RETVAL = ___GNU_MP_VERSION_PATCHLEVEL (aTHX); OUTPUT: RETVAL SV * ___GMP_CC () CODE: RETVAL = ___GMP_CC (aTHX); OUTPUT: RETVAL SV * ___GMP_CFLAGS () CODE: RETVAL = ___GMP_CFLAGS (aTHX); OUTPUT: RETVAL SV * gmp_v () CODE: RETVAL = gmp_v (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION () CODE: RETVAL = _MPFR_VERSION (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_MAJOR () CODE: RETVAL = _MPFR_VERSION_MAJOR (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_MINOR () CODE: RETVAL = _MPFR_VERSION_MINOR (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_PATCHLEVEL () CODE: RETVAL = _MPFR_VERSION_PATCHLEVEL (aTHX); OUTPUT: RETVAL SV * _MPFR_VERSION_STRING () CODE: RETVAL = _MPFR_VERSION_STRING (aTHX); OUTPUT: RETVAL SV * Rmpfr_get_version () CODE: RETVAL = Rmpfr_get_version (aTHX); OUTPUT: RETVAL