This is an automated email from the git hooks/post-receive script.

ppm-guest pushed a commit to annotated tag v0.32
in repository libmath-prime-util-perl.

commit 14b421fb4f4d19e6c8a58a41a21d0823db27cf27
Author: Dana Jacobsen <d...@acm.org>
Date:   Thu Sep 19 17:47:09 2013 -0700

    Test for edge cases, fix some near-maxuv issues
---
 Changes                |   6 +++
 MANIFEST               |   2 +
 XS.xs                  |  76 ++++++++++++++++++++++---------
 xt/primes-edgecases.pl | 120 +++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 183 insertions(+), 21 deletions(-)

diff --git a/Changes b/Changes
index 53c22e5..ff72b29 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,10 @@ Revision history for Perl module Math::Prime::Util
       - is_proven_prime_with_cert
       - carmichael_lambda
       - znorder
+      - prime_iterator_object
+
+    - Added Math::Prime::Util::PrimeIterator.  A more feature-rich iterator
+      than the simple closure one from prime_iterator.  Experimental.
 
     - Input validation accepts bigint objects and converts them to scalars
       entirely in XS.
@@ -37,6 +41,8 @@ Revision history for Perl module Math::Prime::Util
 
     - Primality functions moved to their own file primality.c.
 
+    - Some fixes around near maxint primes, forprimes, etc.
+
 0.31  2013-08-07
 
     - Change proof certificate documentation to reflect the new text format.
diff --git a/MANIFEST b/MANIFEST
index d16dc1e..1222053 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3,6 +3,7 @@ cpanfile
 lib/Math/Prime/Util.pm
 lib/Math/Prime/Util/MemFree.pm
 lib/Math/Prime/Util/PrimeArray.pm
+lib/Math/Prime/Util/PrimeIterator.pm
 lib/Math/Prime/Util/PP.pm
 lib/Math/Prime/Util/ZetaBigFloat.pm
 lib/Math/Prime/Util/ECAffinePoint.pm
@@ -101,6 +102,7 @@ xt/small-is-next-prev.pl
 xt/factor-holf.pl
 xt/make-script-test-data.pl
 xt/pari-totient-moebius.pl
+xt/primes-edgecases.pl
 xt/rwh_primecount.py
 xt/rwh_primecount_numpy.py
 xt/test-bpsw.pl
diff --git a/XS.xs b/XS.xs
index c1f7921..ea74cb6 100644
--- a/XS.xs
+++ b/XS.xs
@@ -48,7 +48,10 @@
 #endif
 
 #if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9)
-#  define PERL_HAS_BAD_MULTICALL_REFCOUNT
+#  define FIX_MULTICALL_REFCOUNT \
+      if (CvDEPTH(multicall_cv) > 1) SvREFCNT_inc(multicall_cv);
+#else
+#  define FIX_MULTICALL_REFCOUNT
 #endif
 #ifndef CvISXSUB
 #  define CvISXSUB(cv) CvXSUB(cv)
@@ -103,10 +106,11 @@ static int _validate_int(SV* n, int negok)
     return -1;
   if (len < uvmax_maxlen)              /* Valid small integer */
     return 1;
-  for (i = 0; i < uvmax_maxlen; i++)   /* Check if in range */
-    if (ptr[i] > uvmax_str[i])
-      return 0;
-  return 1;                            /* Looks good */
+  for (i = 0; i < uvmax_maxlen; i++) { /* Check if in range */
+    if (ptr[i] < uvmax_str[i]) return 1;
+    if (ptr[i] > uvmax_str[i]) return 0;
+  }
+  return 1;                            /* value = UV_MAX.  That's ok */
 }
 
 /* Call a Perl sub to handle work for us.
@@ -261,7 +265,7 @@ trial_primes(IN UV low, IN UV high)
     if (low <= high) {
       if (low >= 2) low--;   /* Make sure low gets included */
       curprime = _XS_next_prime(low);
-      while (curprime <= high) {
+      while (curprime <= high && curprime != 0) {
         av_push(av,newSVuv(curprime));
         curprime = _XS_next_prime(curprime);
       }
@@ -555,18 +559,24 @@ void
 next_prime(IN SV* n)
   ALIAS:
     prev_prime = 1
+  PREINIT:
+    UV val;
   PPCODE:
-    if (_validate_int(n, 0)) {
-      UV val;
-      set_val_from_sv(val, n);
-      if ( (ix && val < 3) || (!ix && val >= _max_prime) )  XSRETURN_UV(0);
-      if (ix) XSRETURN_UV(_XS_prev_prime(val));
-      else    XSRETURN_UV(_XS_next_prime(val));
+    if (ix) {
+      if (_validate_int(n, 0)) {
+        set_val_from_sv(val, n);
+        XSRETURN_UV( (val < 3) ? 0 : _XS_prev_prime(val));
+      }
     } else {
-      _vcallsub((ix == 0) ?  "Math::Prime::Util::_generic_next_prime" :
-                             "Math::Prime::Util::_generic_prev_prime" );
-      XSRETURN(1);
+      if (_validate_int(n, 0)) {
+        set_val_from_sv(val, n);
+        if (val < _max_prime)
+          XSRETURN_UV(_XS_next_prime(val));
+      }
     }
+    _vcallsub((ix == 0) ?  "Math::Prime::Util::_generic_next_prime" :
+                           "Math::Prime::Util::_generic_prev_prime" );
+    XSRETURN(1);
 
 double
 _XS_ExponentialIntegral(IN double x)
@@ -746,7 +756,7 @@ forprimes (SV* block, IN SV* svbeg, IN SV* svend = 0)
     GV *gv;
     HV *stash;
     CV *cv;
-    SV* svarg;
+    SV* svarg;  /* We use svarg to prevent clobbering $_ outside the block */
     void* ctx;
     unsigned char* segment;
     UV seg_base, seg_low, seg_high;
@@ -787,7 +797,34 @@ forprimes (SV* block, IN SV* svbeg, IN SV* svend = 0)
       }
       beg += 1 + (beg > 2);
     }
-    if (beg <= end) {
+    /* For small ranges with large bases or tiny ranges, it will be faster
+     * and less memory to just iterate through the primes in range.  The
+     * exact limits will change based on the sieve vs. next_prime speed. */
+    if (beg <= end && !CvISXSUB(cv) && (
+#if BITS_PER_WORD == 64
+          (beg >= UVCONST(10000000000000000000) && end-beg < 100000000) ||
+          (beg >= UVCONST( 1000000000000000000) && end-beg <  25000000) ||
+          (beg >= UVCONST(  100000000000000000) && end-beg <   8000000) ||
+          (beg >= UVCONST(   10000000000000000) && end-beg <   1700000) ||
+          (beg >= UVCONST(    1000000000000000) && end-beg <    400000) ||
+          (beg >= UVCONST(     100000000000000) && end-beg <    130000) ||
+          (beg >= UVCONST(      10000000000000) && end-beg <     40000) ||
+          (beg >= UVCONST(       1000000000000) && end-beg <     17000) ||
+#endif
+          (                                        end-beg <       500) ) ) {
+      dMULTICALL;
+      I32 gimme = G_VOID;
+      PUSH_MULTICALL(cv);
+      beg = _XS_next_prime(beg-1);
+      while (beg <= end && beg != 0) {
+        sv_setuv(svarg, beg);
+        GvSV(PL_defgv) = svarg;
+        MULTICALL;
+        beg = _XS_next_prime(beg);
+      }
+      FIX_MULTICALL_REFCOUNT;
+      POP_MULTICALL;
+    } else if (beg <= end) {
       ctx = start_segment_primes(beg, end, &segment);
       while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) {
         if (!CvISXSUB(cv)) {
@@ -799,10 +836,7 @@ forprimes (SV* block, IN SV* svbeg, IN SV* svend = 0)
             GvSV(PL_defgv) = svarg;
             MULTICALL;
           } END_DO_FOR_EACH_SIEVE_PRIME
-#ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
-          if (CvDEPTH(multicall_cv) > 1)
-            SvREFCNT_inc(multicall_cv);
-#endif
+          FIX_MULTICALL_REFCOUNT;
           POP_MULTICALL;
         } else {
           START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high 
- seg_base ) {
diff --git a/xt/primes-edgecases.pl b/xt/primes-edgecases.pl
new file mode 100755
index 0000000..88f58b0
--- /dev/null
+++ b/xt/primes-edgecases.pl
@@ -0,0 +1,120 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Math::Prime::Util ':all';
+use Math::Prime::Util::PrimeIterator;
+use Test::More;
+
+my @primes = qw/2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 
83 89 97/;
+my $end = 20;
+
+plan tests => 4*(($end+1)*($end+2)/2)
+            + 4*((101*102)/2)
+            + 10;
+
+diag "Checking small numbers";
+foreach my $b (0 .. $end) {
+  foreach my $e ($b .. $end) {
+    my @p = grep { $_ >= $b && $_ <= $e } @primes;
+    is_deeply( gen_primes($b,$e), \@p, "primes($b,$e)");
+    is_deeply( gen_forprimes($b,$e), \@p, "forprimes {} $b,$e");
+    is_deeply( gen_piterate($b,$e), \@p, "prime_iterator($b) while <= $e");
+    is_deeply( gen_ooiterate($b,$e), \@p, "prime_iterator object $b to $e");
+  }
+}
+
+# TODO We should check boundaries around 1k*30, then segments around 256k*30 
and 64k*30
+
+my @lprimes = (~0 > 4294967295)
+ ? (qw/18446744073709550671 18446744073709550681 18446744073709550717 
18446744073709550719 18446744073709550771 18446744073709550773 
18446744073709550791 18446744073709550873 18446744073709551113 
18446744073709551163 18446744073709551191 18446744073709551253 
18446744073709551263 18446744073709551293 18446744073709551337 
18446744073709551359 18446744073709551427 18446744073709551437 
18446744073709551521 18446744073709551533 18446744073709551557/)
+ : (qw/4294966297 4294966337 4294966367 4294966373 4294966427 4294966441 
4294966447 4294966477 4294966553 4294966583 4294966591 4294966619 4294966639 
4294966651 4294966657 4294966661 4294966667 4294966769 4294966813 4294966829 
4294966877 4294966909 4294966927 4294966943 4294966981 4294966997 4294967029 
4294967087 4294967111 4294967143 4294967161 4294967189 4294967197 4294967231 
4294967279 4294967291/);
+ 
+diag "\nChecking numbers near end with iterator\n";
+foreach my $bdelta (reverse 0 .. 100) {
+  foreach my $edelta (reverse 0 .. $bdelta) {
+    my ($b, $e) = (~0 - $bdelta, ~0 - $edelta);
+    my @p = grep { $_ >= $b && $_ <= $e } @lprimes;
+    is_deeply( gen_piterate($b,$e), \@p, "prime_iterator($b) while <= $e");
+  }
+}
+diag "\nChecking numbers near end with OO iterator\n";
+foreach my $bdelta (reverse 0 .. 100) {
+  foreach my $edelta (reverse 0 .. $bdelta) {
+    my ($b, $e) = (~0 - $bdelta, ~0 - $edelta);
+    my @p = grep { $_ >= $b && $_ <= $e } @lprimes;
+    is_deeply( gen_ooiterate($b,$e), \@p, "prime_iterator object $b to $e");
+  }
+}
+
+diag "\nChecking numbers near end with primes()\n";
+foreach my $bdelta (reverse 0 .. 100) {
+  foreach my $edelta (reverse 0 .. $bdelta) {
+    my ($b, $e) = (~0 - $bdelta, ~0 - $edelta);
+    my @p = grep { $_ >= $b && $_ <= $e } @lprimes;
+    is_deeply( gen_primes($b,$e), \@p, "primes($b,$e)");
+  }
+}
+diag "\nChecking numbers near end with forprimes.\n";
+foreach my $bdelta (reverse 0 .. 100) {
+  foreach my $edelta (reverse 0 .. $bdelta) {
+    my ($b, $e) = (~0 - $bdelta, ~0 - $edelta);
+    my @p = grep { $_ >= $b && $_ <= $e } @lprimes;
+    is_deeply( gen_forprimes($b,$e), \@p, "forprimes {} $b,$e");
+  }
+}
+diag "\nChecking numbers near end with segment primes().  Very slow.\n";
+{
+  my $b = $lprimes[-1] - 1;
+  my $e = ~0;
+  my @p = ($lprimes[-1]);
+  diag "\n    Window around $lprimes[-1]\n";
+  is_deeply( gen_primes({method => 'Segment'}, $b, $b), [], "primes($b,$b)");
+  is_deeply( gen_primes({method => 'Segment'}, $b, $b+1), \@p, 
"primes($b,$b+1)");
+  is_deeply( gen_primes({method => 'Segment'}, $b, $b+2), \@p, 
"primes($b,$b+2)");
+  is_deeply( gen_primes({method => 'Segment'}, $b+1, $b+1), \@p, 
"primes($b+1,$b+1)");
+  is_deeply( gen_primes({method => 'Segment'}, $b+1, $b+2), \@p, 
"primes($b+1,$b+2)");
+  is_deeply( gen_primes({method => 'Segment'}, $b+2, $b+2), [], 
"primes($b+2,$b+2)");
+  diag "\n    Window around $e\n";
+  is_deeply( gen_primes({method => 'Segment'}, $e-2, $e-2), [], 
"primes($e-2,$e-2)");
+  is_deeply( gen_primes({method => 'Segment'}, $e-2, $e), [], 
"primes($e-2,$e)");
+  is_deeply( gen_primes({method => 'Segment'}, $e-1, $e), [], 
"primes($e-1,$e)");
+  is_deeply( gen_primes({method => 'Segment'}, $e, $e), [], "primes($e,$e)");
+}
+
+#diag "\nChecking numbers near end with forprimes.  This will take a *very* 
long time.\n";
+#foreach my $bdelta (reverse 0 .. 9) {
+#  foreach my $edelta (reverse 0 .. $bdelta) {
+#    my ($b, $e) = (~0 - $bdelta, ~0 - $edelta);
+#    my @p = grep { $_ >= $b && $_ <= $e } @lprimes;
+#    is_deeply( gen_forprimes($b,$e), \@p, "forprimes {} $b,$e");
+#  }
+#}
+
+sub gen_primes {
+  return primes(@_);
+}
+sub gen_forprimes {
+  my($b, $e) = @_;
+  my @p;
+  forprimes { push @p, $_ } $b,$e;
+  return \@p;
+}
+sub gen_piterate {
+  my($b, $e) = @_;
+  my @p;
+  my $it = prime_iterator($b);
+  my $n;
+  while (1) {
+    $n = $it->();
+    last if $n > $e || $n == 0;
+    push @p, $n;
+  }
+  return \@p;
+}
+sub gen_ooiterate {
+  my($b, $e) = @_;
+  my @p;
+  my $it = Math::Prime::Util::PrimeIterator->new($b);
+  push @p, $it->iterate while $it->value <= $e;
+  return \@p;
+}

-- 
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