[libmath-prime-util-perl] 04/40: Fix a refcount GMP callback issue, and add test for it

[Partha P. Mukherjee]

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

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

commit b7e26bdec46a56248f030d40037eb710756292ed
Author: Dana Jacobsen <dana at acm.org>
Date:   Thu Jun 20 13:52:28 2013 -0700

    Fix a refcount GMP callback issue, and add test for it
---
 Changes                |  2 ++
 README                 |  2 +-
 XS.xs                  | 35 +++++++++++++++++------------------
 lib/Math/Prime/Util.pm |  4 ++--
 t/70-rt-bignum.t       | 13 ++++++++++++-
 5 files changed, 34 insertions(+), 22 deletions(-)

diff --git a/Changes b/Changes
index 75217f4..1891e0f 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,8 @@ Revision history for Perl extension Math::Prime::Util.
 0.30 
     - Add standard and strong Lucas tests in XS.
 
+    - Fixed a rare refcount / bignum / callback issue.
+
 0.29 30 May 2013
 
     - Fix a signed vs. unsigned char issue in ranged moebius.  Thanks to the
diff --git a/README b/README
index bd23e8f..9356a21 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Math::Prime::Util version 0.29
+Math::Prime::Util version 0.30
 
 A set of utilities related to prime numbers.  These include multiple sieving
 methods, is_prime, prime_count, nth_prime, approximations and bounds for
diff --git a/XS.xs b/XS.xs
index dc8a882..e7817cf 100644
--- a/XS.xs
+++ b/XS.xs
@@ -95,19 +95,21 @@ static int _validate_int(SV* n, int negok)
   return 1;
 }
 
-/* Call a Perl sub with one SV* in and a SV* return value.
- * We use this to foist off big inputs onto Perl.
+/* Call a Perl sub to handle work for us.
+ *   The input is a single SV on the top of the stack.
+ *   The output is a single mortal SV that is on the stack.
  */
-static SV* _callsub(SV* arg, const char* name)
+static void _vcallsub(const char* name)
 {
   dTHX;
   dSP;                               /* Local copy of stack pointer         */
   int count;
-  SV* v;
+  SV* arg;
 
   ENTER;                             /* Start wrapper                       */
   SAVETMPS;                          /* Start (2)                           */
 
+  arg = POPs;                        /* Get argument value from stack       */
   PUSHMARK(SP);                      /* Start args: note our SP             */
   XPUSHs(arg);
   PUTBACK;                           /* End args:   set global SP to ours   */
@@ -118,11 +120,12 @@ static SV* _callsub(SV* arg, const char* name)
   if (count != 1)
     croak("callback sub should return one value");
 
-  v = newSVsv(POPs);                 /* Get the returned value              */
+  TOPs = SvREFCNT_inc(TOPs);         /* Make sure FREETMPS doesn't kill it  */
 
+  PUTBACK;
   FREETMPS;                          /* End wrapper                         */
   LEAVE;                             /* End (2)                             */
-  return v;
+  TOPs = sv_2mortal(TOPs);           /* mortalize it.  refcnt will be 1.    */
 }
 
 #if BITS_PER_WORD == 64
@@ -465,15 +468,14 @@ is_prime(IN SV* n)
     is_prob_prime = 1
   PREINIT:
     int status;
-  CODE:
+  PPCODE:
     status = _validate_int(n, 1);
-    RETVAL = 0;
     if (status == -1) {
-      /* return 0 */
+      XSRETURN_UV(0);
     } else if (status == 1) {
       UV val;
       set_val_from_sv(val, n);
-      RETVAL = _XS_is_prime(val);
+      XSRETURN_UV(_XS_is_prime(val));
     } else {
       SV* result;
       const char* sub = 0;
@@ -483,11 +485,9 @@ is_prime(IN SV* n)
       else
         sub = (ix == 0) ? "Math::Prime::Util::_generic_is_prime"
                         : "Math::Prime::Util::_generic_is_prob_prime";
-      result = _callsub(ST(0), sub);
-      RETVAL = SvIV(result);
+      _vcallsub(sub);
+      XSRETURN(1);
     }
-  OUTPUT:
-    RETVAL
 
 UV
 _XS_next_prime(IN UV n)
@@ -507,10 +507,9 @@ next_prime(IN SV* n)
       if (ix) XSRETURN_UV(_XS_prev_prime(val));
       else    XSRETURN_UV(_XS_next_prime(val));
     } else {
-      SV* result = _callsub(ST(0), (ix == 0) ?
-                       "Math::Prime::Util::_generic_next_prime" :
-                       "Math::Prime::Util::_generic_prev_prime" );
-      XPUSHs(sv_2mortal(result));
+      _vcallsub((ix == 0) ?  "Math::Prime::Util::_generic_next_prime" :
+                             "Math::Prime::Util::_generic_prev_prime" );
+      XSRETURN(1);
     }
 
 
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index 129dcfe..a0d42ca 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -6,7 +6,7 @@ use Bytes::Random::Secure;
 
 BEGIN {
   $Math::Prime::Util::AUTHORITY = 'cpan:DANAJ';
-  $Math::Prime::Util::VERSION = '0.29';
+  $Math::Prime::Util::VERSION = '0.30';
 }
 
 # parent is cleaner, and in the Perl 5.10.1 / 5.12.0 core, but not earlier.
@@ -2418,7 +2418,7 @@ Math::Prime::Util - Utilities related to prime numbers, including fast sieves an
 
 =head1 VERSION
 
-Version 0.29
+Version 0.30
 
 
 =head1 SYNOPSIS
diff --git a/t/70-rt-bignum.t b/t/70-rt-bignum.t
index 2159fb4..b0ec0ef 100644
--- a/t/70-rt-bignum.t
+++ b/t/70-rt-bignum.t
@@ -12,7 +12,7 @@ use warnings;
 use Math::Prime::Util qw/:all/;
 use bignum;
 
-use Test::More tests => 1;
+use Test::More tests => 2;
 
 if ($] < 5.008) {
   diag "A prototype warning was expected with old, old Perl";
@@ -32,3 +32,14 @@ is_deeply( \@partial_factor, \@expected_factors,
 
 # The same thing happens in random primes, PP holf factoring,
 # PP is_provable_primes, and possibly elsewhere
+
+################################################################################
+
+# Here is another test case that has to do with reference counting
+# in the XS subroutine callback code.
+SKIP: {
+  skip "No MPU::GMP, skipping callback test",1 unless prime_get_config->{'gmp'};
+  my $n = 10**1200+5226;
+  my $expect = $n+1;
+  is(next_prime($n), $expect, "next_prime(10^1200+5226) = 10^1200+5227");
+}

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git