BigInt, FastCalc, BitRat, bignum released to CPAN [PATCH]

Message-Id: <200704092059.24058@bloodgate.com>

p4raw-id: //depot/perl@30876

3 files changed, 81 insertions, 30 deletions

diff --git a/ext/Math/BigInt/FastCalc/FastCalc.pm b/ext/Math/BigInt/FastCalc/FastCalc.pm
index 160a218c3c..5b2ea2fdde 100644
--- a/ext/Math/BigInt/FastCalc/FastCalc.pm
+++ b/ext/Math/BigInt/FastCalc/FastCalc.pm
@@ -11,7 +11,7 @@ use vars qw/@ISA $VERSION $BASE $BASE_LEN/;
 
 @ISA = qw(DynaLoader);
 
-$VERSION = '0.12_01';
+$VERSION = '0.13';
 
 bootstrap Math::BigInt::FastCalc $VERSION;
 
diff --git a/ext/Math/BigInt/FastCalc/FastCalc.xs b/ext/Math/BigInt/FastCalc/FastCalc.xs
index 3e53876a22..b00ed05663 100644
--- a/ext/Math/BigInt/FastCalc/FastCalc.xs
+++ b/ext/Math/BigInt/FastCalc/FastCalc.xs
@@ -18,6 +18,20 @@ MODULE = Math::BigInt::FastCalc		PACKAGE = Math::BigInt::FastCalc
  #  * added __strip_zeros(), _copy()
  # 2004-08-13 0.07 Tels
  #  * added _is_two(), _is_ten(), _ten()
+ # 2007-04-02 0.08 Tels
+ #  * plug leaks by creating mortals
+
+#define RETURN_MORTAL_INT(value)		\
+      ST(0) = sv_2mortal(newSViv(value));	\
+      XSRETURN(1);
+
+#define RETURN_MORTAL_BOOL(temp, comp)			\
+      ST(0) = sv_2mortal(boolSV( SvIV(temp) == comp));
+
+#define CONSTANT_OBJ(int)			\
+    RETVAL = newAV();				\
+    sv_2mortal((SV*)RETVAL);			\
+    av_push (RETVAL, newSViv( int ));
 
 void 
 _set_XS_BASE(BASE, BASE_LEN)
@@ -230,11 +244,6 @@ _num(class,x)
 
 ##############################################################################
 
-#define CONSTANT_OBJ(int)		\
-    RETVAL = newAV();			\
-    sv_2mortal((SV*)RETVAL);		\
-    av_push (RETVAL, newSViv( int ));
-
 AV *
 _zero(class)
   CODE:
@@ -281,7 +290,7 @@ _is_even(class, x)
   CODE:
     a = (AV*)SvRV(x);		/* ref to aray, don't check ref */
     temp = *av_fetch(a, 0, 0);	/* fetch first element */
-    ST(0) = boolSV((SvIV(temp) & 1) == 0);
+    ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == 0));
 
 ##############################################################################
 
@@ -295,7 +304,7 @@ _is_odd(class, x)
   CODE:
     a = (AV*)SvRV(x);		/* ref to aray, don't check ref */
     temp = *av_fetch(a, 0, 0);	/* fetch first element */
-    ST(0) = boolSV((SvIV(temp) & 1) != 0);
+    ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) != 0));
 
 ##############################################################################
 
@@ -314,7 +323,7 @@ _is_one(class, x)
       XSRETURN(1);			/* len != 1, can't be '1' */
       }
     temp = *av_fetch(a, 0, 0);		/* fetch first element */
-    ST(0) = boolSV((SvIV(temp) == 1));
+    RETURN_MORTAL_BOOL(temp, 1);
 
 ##############################################################################
 
@@ -333,7 +342,7 @@ _is_two(class, x)
       XSRETURN(1);			/* len != 1, can't be '2' */
       }
     temp = *av_fetch(a, 0, 0);		/* fetch first element */
-    ST(0) = boolSV((SvIV(temp) == 2));
+    RETURN_MORTAL_BOOL(temp, 2);
 
 ##############################################################################
 
@@ -352,7 +361,7 @@ _is_ten(class, x)
       XSRETURN(1);			/* len != 1, can't be '10' */
       }
     temp = *av_fetch(a, 0, 0);		/* fetch first element */
-    ST(0) = boolSV((SvIV(temp) == 10));
+    RETURN_MORTAL_BOOL(temp, 10);
 
 ##############################################################################
 
@@ -371,7 +380,7 @@ _is_zero(class, x)
       XSRETURN(1);			/* len != 1, can't be '0' */
       }
     temp = *av_fetch(a, 0, 0);		/* fetch first element */
-    ST(0) = boolSV((SvIV(temp) == 0));
+    RETURN_MORTAL_BOOL(temp, 0);
 
 ##############################################################################
 
@@ -390,7 +399,7 @@ _len(class,x)
     temp = *av_fetch(a, elems, 0);	/* fetch last element */
     SvPV(temp, len);			/* convert to string & store length */
     len += (IV) XS_BASE_LEN * elems;
-    ST(0) = newSViv(len);
+    ST(0) = sv_2mortal(newSViv(len));
 
 ##############################################################################
 
@@ -418,13 +427,11 @@ _acmp(class, cx, cy);
 
     if (diff > 0)
       {
-      ST(0) = newSViv(1);		/* len differs: X > Y */
-      XSRETURN(1);
+      RETURN_MORTAL_INT(1);		/* len differs: X > Y */
       }
-    if (diff < 0)
+    else if (diff < 0)
       {
-      ST(0) = newSViv(-1);		/* len differs: X < Y */
-      XSRETURN(1);
+      RETURN_MORTAL_INT(-1);		/* len differs: X < Y */
       }
     /* both have same number of elements, so check length of last element
        and see if it differes */
@@ -435,13 +442,11 @@ _acmp(class, cx, cy);
     diff_str = (I32)lenx - (I32)leny;
     if (diff_str > 0)
       {
-      ST(0) = newSViv(1);		/* same len, but first elems differs in len */
-      XSRETURN(1);
+      RETURN_MORTAL_INT(1);		/* same len, but first elems differs in len */
       }
     if (diff_str < 0)
       {
-      ST(0) = newSViv(-1);		/* same len, but first elems differs in len */
-      XSRETURN(1);
+      RETURN_MORTAL_INT(-1);		/* same len, but first elems differs in len */
       }
     /* same number of digits, so need to make a full compare */
     diff_nv = 0;
@@ -458,13 +463,11 @@ _acmp(class, cx, cy);
       } 
     if (diff_nv > 0)
       {
-      ST(0) = newSViv(1);
-      XSRETURN(1);
+      RETURN_MORTAL_INT(1);
       }
     if (diff_nv < 0)
       {
-      ST(0) = newSViv(-1);
-      XSRETURN(1);
+      RETURN_MORTAL_INT(-1);
       }
-    ST(0) = newSViv(0);		/* equal */
+    ST(0) = sv_2mortal(newSViv(0));		/* X and Y are equal */
 
diff --git a/ext/Math/BigInt/FastCalc/t/leak.t b/ext/Math/BigInt/FastCalc/t/leak.t
index c7cae8baf0..b9cc596113 100644
--- a/ext/Math/BigInt/FastCalc/t/leak.t
+++ b/ext/Math/BigInt/FastCalc/t/leak.t
@@ -1,6 +1,9 @@
 #!/usr/bin/perl -w
 
-# Test for memory leaks from _zero() and friends.
+# Test for memory leaks.
+
+# XXX TODO: This test file doesn't actually seem to work! If you remove
+# the sv_2mortal() in the XS file, it still happily passes all tests...
 
 use Test::More;
 use strict;
@@ -10,7 +13,7 @@ BEGIN
   $| = 1;
   chdir 't' if -d 't';
   unshift @INC, ('../lib', '../blib/arch');	# for running manually
-  plan tests => 4;
+  plan tests => 20;
   }
 
 #############################################################################
@@ -18,7 +21,7 @@ package Math::BigInt::FastCalc::LeakCheck;
 use base qw(Math::BigInt::FastCalc);
 
 my $destroyed = 0;
-sub DESTROY { $destroyed++ }
+sub DESTROY { $destroyed++; }
 
 #############################################################################
 package main;
@@ -32,3 +35,48 @@ for my $method (qw(_zero _one _two _ten))
     }
   is ($destroyed, 1, "$method does not leak memory");
   }
+
+my $num = Math::BigInt::FastCalc->_zero();
+for my $method (qw(_is_zero _is_one _is_two _is_ten _num))
+  {
+  $destroyed = 0;
+    {
+    my $rc = Math::BigInt::FastCalc->$method($num);
+    bless \$rc, "Math::BigInt::FastCalc::LeakCheck";
+    }
+  is ($destroyed, 1, "$method does not leak memory");
+  }
+
+my $num_10 = Math::BigInt::FastCalc->_ten();
+my $num_2 = Math::BigInt::FastCalc->_two();
+
+my $num_long   = Math::BigInt::FastCalc->_new("1234567890");
+my $num_long_2 = Math::BigInt::FastCalc->_new("12345678900987654321");
+
+# to hit all possible code branches
+_test_acmp($num, $num);
+_test_acmp($num_10, $num_10);
+_test_acmp($num, $num_10);
+_test_acmp($num_10, $num);
+_test_acmp($num, $num_2);
+_test_acmp($num_2, $num);
+_test_acmp($num_long, $num);
+_test_acmp($num, $num_long);
+_test_acmp($num_long, $num_long);
+_test_acmp($num_long, $num_long_2);
+_test_acmp($num_long_2, $num_long);
+
+sub _test_acmp
+  {
+  my ($n1,$n2) = @_;
+
+  $destroyed = 0;
+    {
+    my $rc = Math::BigInt::FastCalc->_acmp($n1,$n2);
+    bless \$rc, "Math::BigInt::FastCalc::LeakCheck";
+    }
+  my $n_1 = Math::BigInt::FastCalc->_str($n1);
+  my $n_2 = Math::BigInt::FastCalc->_str($n2);
+  is ($destroyed, 1, "_acmp($n_1,$n_2) does not leak memory");
+  }
+