XS::APItest::newCONSTSUB was not handling SV reference counts correctly.

newCONSTSUB() and newCONSTSUB_flags() take ownership of (one reference to)
the passed-in SV. As the XS wrapper is passing in a SV taken from the stack,
it needs to up the reference count by one in order to avoid later bugs.

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index dff9b46..0979aee 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1971,11 +1971,11 @@ newCONSTSUB(stash, name, flags, sv)
     PPCODE:
         switch (ix) {
            case 0:
-              cv = newCONSTSUB(stash, pv, SvOK(sv) ? sv : NULL);
+              cv = newCONSTSUB(stash, pv, SvOK(sv) ? SvREFCNT_inc(sv) : NULL);
                break;
            case 1:
                cv = newCONSTSUB_flags(
-                 stash, pv, len, flags | SvUTF8(name), SvOK(sv) ? sv : NULL
+                 stash, pv, len, flags | SvUTF8(name), SvOK(sv) ? SvREFCNT_inc(sv) : NULL
                );
                break;
         }

diff --git a/ext/XS-APItest/t/newCONSTSUB.t b/ext/XS-APItest/t/newCONSTSUB.t
index e90cfe0..2df850e 100644 (file)
--- a/ext/XS-APItest/t/newCONSTSUB.t
+++ b/ext/XS-APItest/t/newCONSTSUB.t
@@ -3,7 +3,7 @@
 use strict;
 use utf8;
 use open qw( :utf8 :std );
-use Test::More tests => 14;
+use Test::More tests => 22;
 
 use XS::APItest;
 
@@ -69,3 +69,34 @@ eval q{
  like $w, qr/Constant subroutine \x{100} redefined at /,
    'newCONSTSUB constant redefinition warning + utf8';
 }
+
+# XS::APItest was not handling references correctly here
+
+package Counter {
+    our $count = 0;
+
+    sub new {
+        ++$count;
+        my $o = bless [];
+        return $o;
+    }
+
+    sub DESTROY {
+        --$count;
+    }
+};
+
+foreach (['newCONSTSUB', 'ZZIP'],
+         ['newCONSTSUB_flags', 'BRRRAPP']) {
+    my ($using, $name) = @$_;
+    is($Counter::count, 0, 'No objects exist before we start');
+    my $sub = XS::APItest->can($using);
+    ($const, $glob) = $sub->(\%::, $name, 0, Counter->new());
+    is($const, 1, "subroutine generated by $using is CvCONST");
+    is($Counter::count, 1, '1 object now exists');
+    {
+        no warnings 'redefine';
+        *$glob = sub () {};
+    }
+    is($Counter::count, 0, 'no objects remain');
+}