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 <d...@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(",",@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to