[libmath-prime-util-perl] 94/181: Input validation and better 5.6.2 support
Partha P. Mukherjee
ppm-guest at moszumanska.debian.org
Thu May 21 18:51:10 UTC 2015
This is an automated email from the git hooks/post-receive script.
ppm-guest pushed a commit to annotated tag v0.36
in repository libmath-prime-util-perl.
commit 2f048d21f11ac50e4512f3626f084a5af8b37598
Author: Dana Jacobsen <dana at acm.org>
Date: Wed Jan 1 22:41:03 2014 -0800
Input validation and better 5.6.2 support
---
XS.xs | 59 +++++++++++++----------
lehmer.c | 8 ++--
lib/Math/Prime/Util.pm | 62 ++++++++-----------------
lib/Math/Prime/Util/PP.pm | 68 ++++++++++++++++-----------
t/04-inputvalidation.t | 116 ++++++++++++++++++++++++++--------------------
t/16-randomprime.t | 2 +-
t/81-bignum.t | 24 +++++-----
7 files changed, 177 insertions(+), 162 deletions(-)
diff --git a/XS.xs b/XS.xs
index e478c25..9cfbd15 100644
--- a/XS.xs
+++ b/XS.xs
@@ -89,7 +89,7 @@ static int _validate_int(pTHX_ SV* n, int negok)
const char* maxstr;
char* ptr;
STRLEN i, len, maxlen;
- int ret, isneg = 0;
+ int ret, isbignum = 0, isneg = 0;
/* TODO: magic, grok_number, etc. */
if ((SvFLAGS(n) & (SVf_IOK |
@@ -103,9 +103,16 @@ static int _validate_int(pTHX_ SV* n, int negok)
if (negok) return -1;
else croak("Parameter '%" SVf "' must be a positive integer", n);
}
- if (SvGAMAGIC(n)) return 0; /* Leave while we still can */
+ if (SvROK(n)) {
+ if (sv_isa(n, "Math::BigInt") || sv_isa(n, "Math::BigFloat") ||
+ sv_isa(n, "Math::GMP") || sv_isa(n, "Math::GMPz") )
+ isbignum = 1;
+ else
+ return 0;
+ }
+ /* Without being very careful, don't process magic variables here */
+ if (SvGAMAGIC(n) && !isbignum) return 0;
if (!SvOK(n)) croak("Parameter must be defined");
- if (SvROK(n) && !sv_isa(n, "Math::BigInt")) return 0;
ptr = SvPV_nomg(n, len); /* Includes stringifying bigints */
if (len == 0 || ptr == 0) croak("Parameter must be a positive integer");
if (ptr[0] == '-' && negok) {
@@ -337,33 +344,35 @@ trial_factor(IN UV n, ...)
PUSHs(sv_2mortal(newSVuv( factors[i] )));
}
-int
-_XS_miller_rabin(IN UV n, ...)
- CODE:
+void
+is_strong_pseudoprime(IN SV* svn, ...)
+ PREINIT:
+ int status;
+ PPCODE:
if (items < 2)
croak("No bases given to miller_rabin");
- if ( (n == 0) || (n == 1) ) { RETVAL = 0; } /* 0 and 1 composite */
- else if ( (n == 2) || (n == 3) ) { RETVAL = 1; } /* 2 and 3 prime */
- else if ( (n % 2) == 0 ) { RETVAL = 0; } /* MR works on odds */
- else {
- UV bases[64];
- int prob_prime = 1;
- int c = 1;
- while (c < items) {
- int b = 0;
- while (c < items) {
- bases[b++] = SvUV(ST(c));
- c++;
- if (b == 64) break;
+ status = _validate_int(aTHX_ svn, 0);
+ if (status == 1) {
+ UV n = my_svuv(svn);
+ int b, c, ret = 1;
+ if (n < 4) { ret = (n >= 2); } /* 0,1 composite; 2,3 prime */
+ else if ((n % 2) == 0) { ret = 0; } /* evens composite */
+ else {
+ UV bases[32];
+ for (c = 1; c < items && ret == 1; ) {
+ for (b = 0; b < 32 && c < items; c++)
+ bases[b++] = my_svuv(ST(c));
+ ret = _XS_miller_rabin(n, bases, b);
}
- prob_prime = _XS_miller_rabin(n, bases, b);
- if (prob_prime != 1)
- break;
}
- RETVAL = prob_prime;
+ XSRETURN_UV(ret);
+ } else {
+ _vcallsubn(G_SCALAR,
+ _XS_get_callgmp() ? "GMP::is_strong_pseudoprime"
+ : "_generic_is_strong_pseudoprime",
+ items);
+ return; /* skip implicit PUTBACK */
}
- OUTPUT:
- RETVAL
void
_XS_lucas_sequence(IN UV n, IN IV P, IN IV Q, IN UV k)
diff --git a/lehmer.c b/lehmer.c
index 47e9443..48217f9 100644
--- a/lehmer.c
+++ b/lehmer.c
@@ -884,9 +884,9 @@ int main(int argc, char *argv[])
#else
#include "lehmer.h"
-UV _XS_LMOS_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); }
-UV _XS_lehmer_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); }
-UV _XS_meissel_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); }
-UV _XS_legendre_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); }
+UV _XS_LMOS_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); }
+UV _XS_lehmer_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); }
+UV _XS_meissel_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); }
+UV _XS_legendre_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); }
#endif
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index 1e8b324..8f550e6 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -63,7 +63,6 @@ sub _import_nobigint {
#undef *prime_count; *prime_count = \&_XS_prime_count;
undef *nth_prime; *nth_prime = \&_XS_nth_prime;
undef *is_pseudoprime; *is_pseudoprime = \&_XS_is_pseudoprime;
- undef *is_strong_pseudoprime; *is_strong_pseudoprime = \&_XS_miller_rabin;
undef *chebyshev_theta; *chebyshev_theta = \&_XS_chebyshev_theta;
undef *chebyshev_psi; *chebyshev_psi = \&_XS_chebyshev_psi;
# These should be fast anyway, but this skips validation.
@@ -85,6 +84,7 @@ BEGIN {
use constant MPU_MAXDIGITS => ($Config{uvsize} == 4) ? 10 : 20;
use constant MPU_MAXPRIME => ($Config{uvsize} == 4) ? 4294967291 : 18446744073709551557;
use constant MPU_MAXPRIMEIDX => ($Config{uvsize} == 4) ? 203280221 : 425656284035217743;
+ use constant UVPACKLET => ($Config{uvsize} == 8 ? 'Q' : 'L');
no Config;
# Load PP code. Nothing exported.
@@ -119,6 +119,7 @@ BEGIN {
*znorder = \&Math::Prime::Util::_generic_znorder;
*znprimroot = \&Math::Prime::Util::_generic_znprimroot;
*legendre_phi = \&Math::Prime::Util::PP::_legendre_phi;
+ *is_strong_pseudoprime=\&Math::Prime::Util::_generic_is_strong_pseudoprime;
*factor = \&Math::Prime::Util::_generic_factor;
*factor_exp = \&Math::Prime::Util::_generic_factor_exp;
*divisors = \&Math::Prime::Util::_generic_divisors;
@@ -161,7 +162,7 @@ END {
}
croak "Perl and XS don't agree on bit size"
- if MPU_MAXBITS != _XS_prime_maxbits();
+ if $_Config{'xs'} && MPU_MAXBITS != _XS_prime_maxbits();
$_Config{'maxparam'} = MPU_MAXPARAM;
$_Config{'maxdigits'} = MPU_MAXDIGITS;
@@ -231,31 +232,14 @@ sub prime_set_config {
1;
}
-sub _validate_positive_integer {
- my($n, $min, $max) = @_;
- # We need to handle bigints, magic variables, and coderefs
- if (ref($n) eq 'CODE') {
- $_[0] = $_[0]->();
- $n = $_[0];
- }
- croak "Parameter '$n' must be a positive integer"
- if ref($n) eq 'Math::BigInt' && $n->sign() ne '+';
- croak "Parameter '$n' must be >= $min" if defined $min && $n < $min;
- croak "Parameter '$n' must be <= $max" if defined $max && $n > $max;
-
- $_[0] = Math::BigInt->new("$_[0]") unless ref($_[0]) eq 'Math::BigInt';
- croak "Parameter '$_[0]' must be a positive integer" unless $_[0]->is_int();
- if ($_[0]->bacmp(''.~0) <= 0) {
- $_[0] = int($_[0]->bstr);
- } else {
- $_[0]->upgrade(undef) if $_[0]->upgrade(); # Stop BigFloat upgrade
- }
- # One of these will be true:
- # 1) $n <= ~0 and $n is not a bigint
- # 2) $n > ~0 and $n is a bigint
- 1;
+
+sub _bigint_to_int {
+ return (OLD_PERL_VERSION) ? unpack(UVPACKLET,pack(UVPACKLET,$_[0]->bstr))
+ : int($_[0]->bstr);
}
+*_validate_positive_integer = \&Math::Prime::Util::PP::_validate_positive_integer;
+
sub _upgrade_to_float {
do { require Math::BigFloat; Math::BigFloat->import(); }
if !defined $Math::BigFloat::VERSION;
@@ -731,7 +715,7 @@ sub primes {
my $primelow = $low + 2 * $binsize * $rpart;
my $partsize = ($rpart < $nparts) ? $binsize
: $oddrange - ($nparts * $binsize);
- $partsize = int($partsize->bstr) if ref($partsize) eq 'Math::BigInt';
+ $partsize = _bigint_to_int($partsize) if ref($partsize) eq 'Math::BigInt';
#warn "range $oddrange = $nparts * $binsize + ", $oddrange - ($nparts * $binsize), "\n";
#warn " chose part $rpart size $partsize\n";
#warn " primelow is $low + 2 * $binsize * $rpart = $primelow\n";
@@ -763,7 +747,7 @@ sub primes {
# of 2, 3, or 5, without even having to create the bigint prime.
my @w30 = (1,0,5,4,3,2,1,0,3,2,1,0,1,0,3,2,1,0,1,0,3,2,1,0,5,4,3,2,1,0);
my $primelow30 = $primelow % 30;
- $primelow30 = int($primelow30->bstr) if ref($primelow30) eq 'Math::BigInt';
+ $primelow30 = _bigint_to_int($primelow30) if ref($primelow30) eq 'Math::BigInt';
# Big GCD's are hugely fast with GMP or Pari, but super slow with Calc.
_make_big_gcds() if $_big_gcd_use < 0;
@@ -930,8 +914,8 @@ sub primes {
# Precalculate some modulii so we can do trial division on native int
# 9699690 = 2*3*5*7*11*13*17*19, so later operations can be native ints
my @premod;
- my $bpremod = int($b->copy->bmod(9699690)->bstr);
- my $twopremod = int(Math::BigInt->new(2)->bmodpow($bits-$l-1, 9699690)->bstr);
+ my $bpremod = _bigint_to_int($b->copy->bmod(9699690));
+ my $twopremod = _bigint_to_int(Math::BigInt->new(2)->bmodpow($bits-$l-1, 9699690));
foreach my $zi (0 .. 19-1) {
foreach my $pm (3, 5, 7, 11, 13, 17, 19) {
next if $zi >= $pm || defined $premod[$pm];
@@ -1098,7 +1082,7 @@ sub primes {
next unless Math::BigInt::bgcd($n, $_big_gcd[3]) == 1;
}
print "+" if $verbose > 2;
- next unless Math::Prime::Util::is_strong_pseudoprime($n, 3);
+ next unless is_strong_pseudoprime($n, 3);
}
print "*" if $verbose > 2;
@@ -1503,7 +1487,7 @@ sub _generic_carmichael_lambda {
map { [ map { Math::BigInt->new("$_") } @$_ ] }
@pe
);
- $lcm = int($lcm->bstr) if $lcm->bacmp(''.~0) <= 0;
+ $lcm = _bigint_to_int($lcm) if $lcm->bacmp(''.~0) <= 0;
return $lcm;
}
@@ -1543,7 +1527,7 @@ sub _generic_znorder {
$k *= $pi;
}
}
- $k = int($k->bstr) if $k->bacmp(''.~0) <= 0;
+ $k = _bigint_to_int($k) if $k->bacmp(''.~0) <= 0;
return $k;
}
@@ -1606,7 +1590,6 @@ sub _generic_is_prime {
return 0 if defined $n && $n < 2;
_validate_num($n) || _validate_positive_integer($n);
- return _XS_is_prime($n) if $n <= $_XS_MAXVAL;
return Math::Prime::Util::GMP::is_prime($n) if $_HAVE_GMP;
if ($n < 7) { return ($n == 2) || ($n == 3) || ($n == 5) ? 2 : 0; }
@@ -1619,7 +1602,6 @@ sub _generic_is_prob_prime {
return 0 if defined $n && $n < 2;
_validate_num($n) || _validate_positive_integer($n);
- return _XS_is_prob_prime($n) if $n <= $_XS_MAXVAL;
return Math::Prime::Util::GMP::is_prob_prime($n) if $_HAVE_GMP;
if ($n < 7) { return ($n == 2) || ($n == 3) || ($n == 5) ? 2 : 0; }
@@ -1759,7 +1741,7 @@ sub _generic_divisors {
foreach my $f1 (factor($n)) {
next if $f1 >= $n;
my $big_f1 = Math::BigInt->new("$f1");
- my @to_add = map { ($_ <= ~0) ? int($_->bstr) : $_ }
+ my @to_add = map { ($_ <= ''.~0) ? _bigint_to_int($_) : $_ }
grep { $_ < $n }
map { $big_f1 * $_ }
keys %all_factors;
@@ -1784,12 +1766,10 @@ sub is_pseudoprime {
return Math::Prime::Util::PP::is_pseudoprime($n, $a);
}
-sub is_strong_pseudoprime {
+sub _generic_is_strong_pseudoprime {
my($n) = shift;
_validate_num($n) || _validate_positive_integer($n);
# validate bases?
- return _XS_miller_rabin($n, @_)
- if $n <= $_XS_MAXVAL;
return Math::Prime::Util::GMP::is_strong_pseudoprime($n, @_) if $_HAVE_GMP;
return Math::Prime::Util::PP::miller_rabin($n, @_);
}
@@ -1899,11 +1879,7 @@ sub miller_rabin_random {
while ($k > 0) {
my $nbases = ($k >= 20) ? 20 : $k;
my @bases = map { $irandf->($brange)+2 } 1..$nbases;
- if ($n <= $_XS_MAXVAL) {
- return 0 unless _XS_miller_rabin($n, @bases);
- } else {
- return 0 unless is_strong_pseudoprime($n, @bases);
- }
+ return 0 unless is_strong_pseudoprime($n, @bases);
$k -= $nbases;
}
1;
diff --git a/lib/Math/Prime/Util/PP.pm b/lib/Math/Prime/Util/PP.pm
index e43c4c7..0f083be 100644
--- a/lib/Math/Prime/Util/PP.pm
+++ b/lib/Math/Prime/Util/PP.pm
@@ -24,6 +24,7 @@ BEGIN {
use constant MPU_64BIT => ($Config{uvsize} == 8);
use constant MPU_32BIT => ($Config{uvsize} == 4);
use constant MPU_HALFWORD => ($Config{uvsize} == 4) ? 65536 : ($] < 5.008) ? 33554432 : 4294967296;
+ use constant UVPACKLET => ($Config{uvsize} == 8 ? 'Q' : 'L');
no Config;
}
@@ -61,13 +62,18 @@ sub _is_positive_int {
((defined $_[0]) && $_[0] ne '' && ($_[0] !~ tr/0123456789//c));
}
+sub _bigint_to_int {
+ return (OLD_PERL_VERSION) ? unpack(UVPACKLET,pack(UVPACKLET,$_[0]->bstr))
+ : int($_[0]->bstr);
+}
+
sub _validate_num {
my($n, $min, $max) = @_;
croak "Parameter must be defined" if !defined $n;
return 0 if ref($n);
croak "Parameter must be a positive integer" if $n eq '';
croak "Parameter '$n' must be a positive integer"
- if $n =~ tr/0123456789//c && $n !~ /^\+\d+/;
+ if $n =~ tr/0123456789//c && $n !~ /^\+\d+$/;
croak "Parameter '$n' must be >= $min" if defined $min && $n < $min;
croak "Parameter '$n' must be <= $max" if defined $max && $n > $max;
substr($_[0],0,1,'') if substr($n,0,1) eq '+';
@@ -78,20 +84,28 @@ sub _validate_num {
sub _validate_positive_integer {
my($n, $min, $max) = @_;
croak "Parameter must be defined" if !defined $n;
- croak "Parameter '$n' must be a positive integer"
- if ref($n) ne 'Math::BigInt' && ($n =~ tr/0123456789//c && $n !~ /^\+\d+/);
- croak "Parameter '$n' must be >= $min" if defined $min && $n < $min;
- croak "Parameter '$n' must be <= $max" if defined $max && $n > $max;
- $_[0] = Math::BigInt->new("$_[0]") unless ref($_[0]) eq 'Math::BigInt';
- if ($_[0]->bacmp(''.~0) <= 0) {
- $_[0] = int($_[0]->bstr);
+ if (ref($n) eq 'CODE') {
+ $_[0] = $_[0]->();
+ $n = $_[0];
+ }
+ if (ref($n) eq 'Math::BigInt') {
+ croak "Parameter '$n' must be a positive integer"
+ if $n->sign() ne '+' || !$n->is_int();
+ $_[0] = _bigint_to_int($_[0])
+ if $n <= (OLD_PERL_VERSION ? 562949953421312 : ~0);
} else {
- # Stop BigFloat upgrade
- $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade();
+ my $strn = "$n";
+ croak "Parameter '$strn' must be a positive integer"
+ if $strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/;
+ if ($n <= (OLD_PERL_VERSION ? 562949953421312 : ~0)) {
+ $_[0] = $strn if ref($n);
+ } else {
+ $_[0] = Math::BigInt->new($strn)
+ }
}
- # One of these will be true:
- # 1) $n <= ~0 and $n is not a bigint
- # 2) $n > ~0 and $n is a bigint
+ $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade();
+ croak "Parameter '$_[0]' must be >= $min" if defined $min && $_[0] < $min;
+ croak "Parameter '$_[0]' must be <= $max" if defined $max && $_[0] > $max;
1;
}
@@ -689,7 +703,7 @@ sub _lehmer_pi {
? $x**(1/3)+0.5
: Math::BigFloat->new($x)->broot(3)->badd(0.5)->bfloor
));
- ($z, $a, $b, $c) = map { (ref($_) =~ /^Math::Big/) ? int($_->bstr) : $_ }
+ ($z, $a, $b, $c) = map { (ref($_) =~ /^Math::Big/) ? _bigint_to_int($_) : $_ }
($z, $a, $b, $c);
# Generate at least b primes.
@@ -1041,7 +1055,7 @@ sub kronecker {
# If a,b are bigints and now small enough, finish as native.
if ( ref($a) eq 'Math::BigInt' && $a <= ''.~0
&& ref($b) eq 'Math::BigInt' && $b <= ''.~0) {
- return $k * kronecker(int($a->bstr), int($b->bstr));
+ return $k * kronecker(_bigint_to_int($a),_bigint_to_int($b));
}
}
return ($b == 1) ? $k : 0;
@@ -1051,7 +1065,7 @@ sub _is_perfect_square {
my($n) = @_;
if (ref($n) eq 'Math::BigInt') {
- my $mc = int(($n & 31)->bstr);
+ my $mc = _bigint_to_int($n & 31);
if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) {
my $sq = $n->copy->bsqrt->bfloor;
$sq->bmul($sq);
@@ -1445,12 +1459,12 @@ sub is_aks_prime {
if !defined $Math::BigFloat::VERSION;
# limit = floor( log2(n) * log2(n) ). o_r(n) must be larger than this
my $floatn = Math::BigFloat->new($n);
- my $sqrtn = int($floatn->copy->bsqrt->bfloor->bstr);
+ my $sqrtn = _bigint_to_int($floatn->copy->bsqrt->bfloor);
# The following line seems to trigger a memory leak in Math::BigFloat::blog
# (the part where $MBI is copied to $int) if $n is a Math::BigInt::GMP.
my $log2n = $floatn->copy->blog(2);
my $log2_squared_n = $log2n * $log2n;
- my $limit = int($log2_squared_n->bfloor->bstr);
+ my $limit = _bigint_to_int($log2_squared_n->bfloor);
my $r = next_prime($limit);
foreach my $f (@{primes(0,$r-1)}) {
@@ -1468,13 +1482,13 @@ sub is_aks_prime {
return 1 if $r >= $n;
# Since r is a prime, phi(r) = r-1
- my $rlimit = int( Math::BigFloat->new("$r")->bdec()
- ->bsqrt->bmul($log2n)->bfloor->bstr);
+ my $rlimit = _bigint_to_int( Math::BigFloat->new("$r")->bdec()
+ ->bsqrt->bmul($log2n)->bfloor);
$_poly_bignum = 1;
if ( $n < (MPU_HALFWORD-1) ) {
$_poly_bignum = 0;
- $n = int($n->bstr) if ref($n) eq 'Math::BigInt';
+ $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt';
}
for (my $a = 1; $a <= $rlimit; $a++) {
@@ -1506,7 +1520,7 @@ sub _basic_factor {
}
}
}
- $_[0] = int($_[0]->bstr) if $_[0] <= ''.~0;
+ $_[0] = _bigint_to_int($_[0]) if $_[0] <= ''.~0;
}
if ( ($_[0] > 1) && _is_prime7($_[0]) ) {
@@ -1530,7 +1544,7 @@ sub trial_factor {
while ( !($n % 2) ) { push @factors, 2; $n = int($n / 2); }
while ( !($n % 3) ) { push @factors, 3; $n = int($n / 3); }
while ( !($n % 5) ) { push @factors, 5; $n = int($n / 5); }
- $n = int($n->bstr) if ref($n) eq 'Math::BigInt' && $n <= ''.~0;
+ $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= ''.~0;
return @factors if $n < 4;
my $limit = int(sqrt($n) + 0.001);
@@ -1540,7 +1554,7 @@ sub trial_factor {
foreach my $finc (4, 2, 4, 2, 4, 6, 2, 6) {
if ( (($n % $f) == 0) && ($f <= $limit) ) {
do { push @factors, $f; $n = int($n/$f); } while (($n % $f) == 0);
- $n = int($n->bstr) if ref($n) eq 'Math::BigInt' && $n <= ''.~0;
+ $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= ''.~0;
#last SEARCH if $n == 1 || Math::Prime::Util::is_prob_prime($n);
last SEARCH if $n == 1;
$limit = int( sqrt($n) + 0.001);
@@ -1602,7 +1616,7 @@ sub factor {
while (@nstack) {
$n = pop @nstack;
# Don't use bignum on $n if it has gotten small enough.
- $n = int($n->bstr) if ref($n) eq 'Math::BigInt' && $n <= ''.~0;
+ $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= ''.~0;
#print "Looking at $n with stack ", join(",", at nstack), "\n";
while ( ($n >= (31*31)) && !_is_prime7($n) ) {
my @ftry;
@@ -1964,7 +1978,7 @@ sub holf_factor {
$s->binc;
my $m = ($s * $s) - $ni;
# Check for perfect square
- my $mc = int(($m & 31)->bstr);
+ my $mc = _bigint_to_int($m & 31);
next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25;
my $f = $m->copy->bsqrt->bfloor->as_int;
next unless ($f*$f) == $m;
@@ -2004,7 +2018,7 @@ sub fermat_factor {
my $b2 = $pa*$pa - $n;
my $lasta = $pa + $rounds;
while ($pa <= $lasta) {
- my $mc = int(($b2 & 31)->bstr);
+ my $mc = _bigint_to_int($b2 & 31);
if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) {
my $s = $b2->copy->bsqrt->bfloor->as_int;
if ($s*$s == $b2) {
diff --git a/t/04-inputvalidation.t b/t/04-inputvalidation.t
index e4c9b17..7b25278 100644
--- a/t/04-inputvalidation.t
+++ b/t/04-inputvalidation.t
@@ -4,59 +4,75 @@ use warnings;
use Test::More;
use Math::Prime::Util qw/next_prime/;
+use Math::BigInt try=>"GMP,Pari";
+use Math::BigFloat;
+use Carp;
-plan tests => 22;
+my @incorrect = (
+ -4,
+ '-',
+ '+',
+ '++4',
+ '+-4',
+ '-0004',
+ 'a',
+ '5.6',
+ '4e',
+ '1.1e12',
+ '1e8',
+ 'NaN',
+ Math::BigInt->bnan(),
+ Math::BigInt->new("-4"),
+ Math::BigFloat->new("15.6"),
+);
+
+my %correct = (
+ 4 => 5,
+ '+4' => 5,
+ '0004' => 5,
+ '+0004' => 5,
+ 5.0 => 7,
+ 1e8 => 100000007,
+ Math::BigInt->new("10000000000000000000000012") => "10000000000000000000000013",
+ Math::BigFloat->new("9") => 11,
+);
+
+plan tests => 2 # undefined and empty string
+ + scalar(@incorrect) # values that should be rejected
+ + scalar(keys(%correct)) # values that should be accepted
+ + 2 # infinity and nan
+ + 1; # long invalid string
eval { next_prime(undef); };
like($@, qr/^Parameter must be defined/, "next_prime(undef)");
+
eval { next_prime(""); };
like($@, qr/^Parameter must be a positive integer/, "next_prime('')");
-eval { next_prime(-4); };
-like($@, qr/^Parameter '-4' must be a positive integer/, "next_prime(-4)");
-eval { next_prime("-"); };
-like($@, qr/^Parameter '-' must be a positive integer/, "next_prime('-')");
-eval { next_prime("+"); };
-like($@, qr/^Parameter '\+' must be a positive integer/, "next_prime('+')");
-
-# +4 is fine
-is(next_prime("+4"), 5, "next_prime('+4') works");
-# ++4 does not
-eval { next_prime("++4"); };
-like($@, qr/^Parameter '\+\+4' must be a positive integer/, "next_prime('++4')");
-eval { next_prime("+-4"); };
-like($@, qr/^Parameter '\+\-4' must be a positive integer/, "next_prime('+-4')");
-
-# Test leading zeros
-is(next_prime("0004"), 5, "next_prime('0004') works");
-is(next_prime("+0004"), 5, "next_prime('+0004') works");
-eval { next_prime("-0004"); };
-like($@, qr/^Parameter '\-0004' must be a positive integer/, "next_prime('-0004')");
-
-eval { next_prime("a"); };
-like($@, qr/^Parameter 'a' must be a positive integer/, "next_prime('a')");
-eval { next_prime(5.6); };
-like($@, qr/^Parameter '5.6' must be a positive integer/, "next_prime('5.6')");
-
-# 5.0 should be ok.
-is(next_prime(5.0), 7, "next_prime(5.0) works");
-eval { next_prime("4e"); };
-like($@, qr/^Parameter '4e' must be a positive integer/, "next_prime('4e')");
-eval { next_prime("1.1e12"); };
-like($@, qr/^Parameter '1.1e12' must be a positive integer/, "next_prime('1.1e12')");
-
-# 1e8 as a string will fail, as a number will work.
-eval { next_prime("1e8"); };
-like($@, qr/^Parameter '1e8' must be a positive integer/, "next_prime('1e8')");
-is(next_prime(1e8), 100000007, "next_prime(1e8) works");
-
-eval { next_prime("NaN"); };
-like($@, qr/^Parameter 'NaN' must be a positive integer/, "next_prime('NaN')");
-
-# The actual strings can be implementation specific
-eval { next_prime(0+'inf'); };
-like($@, qr/must be a positive integer/, "next_prime(0+'inf')");
-eval { next_prime(20**20**20); };
-like($@, qr/must be a positive integer/, "next_prime(20**20**20)");
-
-eval { next_prime("11111111111111111111111111111111111111111x"); };
-like($@, qr/must be a positive integer/, "next_prime('111...111x')");
+
+foreach my $v (@incorrect) {
+ eval { next_prime($v); };
+ like($@, qr/^Parameter '\Q$v\E' must be a positive integer/, "next_prime($v)");
+}
+
+while (my($v, $expect) = each (%correct)) {
+ is(next_prime($v), $expect, "Correct: next_prime($v)");
+}
+
+# The actual strings can be implementation specific.
+my $infinity = 0+'inf'; # Might be 0 on some platforms.
+$infinity = +(20**20**20) if 65535 > $infinity;
+my $nan = $infinity / $infinity;
+
+eval { next_prime($infinity); };
+like($@, qr/must be a positive integer/, "next_prime( infinity )");
+
+eval { next_prime($nan); };
+like($@, qr/must be a positive integer/, "next_prime( nan )");
+
+
+SKIP: {
+ skip "You need to upgrade either Perl or Carp to avoid invalid non-native inputs from causing a segfault. Makefile.PL should have requested a Carp upgrade.", 1
+ if $] < 5.008 && $Carp::VERSION < 1.17;
+ eval { next_prime("11111111111111111111111111111111111111111x"); };
+ like($@, qr/must be a positive integer/, "next_prime('111...111x')");
+}
diff --git a/t/16-randomprime.t b/t/16-randomprime.t
index 96f8bf7..ac41023 100644
--- a/t/16-randomprime.t
+++ b/t/16-randomprime.t
@@ -24,7 +24,7 @@ push @random_nbit_tests, (34) if $use64;
my @random_ndigit_tests = (1 .. ($use64 ? 20 : 10));
if ($use64 && $broken64) {
- diag "Skipping some values for with broken 64-bit Perl\n";
+ diag "Skipping some values with broken 64-bit Perl\n";
@random_ndigit_tests = grep { $_ < 10 } @random_ndigit_tests;
@random_nbit_tests = grep { $_ < 50 } @random_nbit_tests;
}
diff --git a/t/81-bignum.t b/t/81-bignum.t
index de1038e..6f84dfc 100644
--- a/t/81-bignum.t
+++ b/t/81-bignum.t
@@ -255,25 +255,25 @@ SKIP: {
ok( is_prime($randprime), "random range prime is prime");
$randprime = random_ndigit_prime(25);
- cmp_ok( $randprime, '>', 10**24, "random 25-digit prime isn't too small");
- cmp_ok( $randprime, '<', 10**25, "random 25-digit prime isn't too big");
- ok( is_prime($randprime), "random 25-digit prime is prime");
+ cmp_ok( $randprime, '>', 10**24, "random 25-digit prime is not too small");
+ cmp_ok( $randprime, '<', 10**25, "random 25-digit prime is not too big");
+ ok( is_prime($randprime), "random 25-digit prime is just right");
}
$randprime = random_nbit_prime(80);
-cmp_ok( $randprime, '>', 2**79, "random 80-bit prime isn't too small");
-cmp_ok( $randprime, '<', 2**80, "random 80-bit prime isn't too big");
-ok( is_prime($randprime), "random 80-bit prime is prime");
+cmp_ok( $randprime, '>', 2**79, "random 80-bit prime is not too small");
+cmp_ok( $randprime, '<', 2**80, "random 80-bit prime is not too big");
+ok( is_prime($randprime), "random 80-bit prime is just right");
$randprime = random_strong_prime(256);
-cmp_ok( $randprime, '>', 2**255, "random 256-bit strong prime isn't too small");
-cmp_ok( $randprime, '<', 2**256, "random 256-bit strong prime isn't too big");
-ok( is_prime($randprime), "random 80-bit strong prime is prime");
+cmp_ok( $randprime, '>', 2**255, "random 256-bit strong prime is not too small");
+cmp_ok( $randprime, '<', 2**256, "random 256-bit strong prime is not too big");
+ok( is_prime($randprime), "random 256-bit strong prime is just right");
$randprime = random_maurer_prime(80);
-cmp_ok( $randprime, '>', 2**79, "random 80-bit Maurer prime isn't too small");
-cmp_ok( $randprime, '<', 2**80, "random 80-bit Maurer prime isn't too big");
-ok( is_prime($randprime), "random 80-bit Maurer prime is prime");
+cmp_ok( $randprime, '>', 2**79, "random 80-bit Maurer prime is not too small");
+cmp_ok( $randprime, '<', 2**80, "random 80-bit Maurer prime is not too big");
+ok( is_prime($randprime), "random 80-bit Maurer prime is just right");
###############################################################################
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git
More information about the Pkg-perl-cvs-commits
mailing list