summaryrefslogtreecommitdiff
path: root/ext/XS-APItest
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2012-08-13 15:11:41 +0200
committerNicholas Clark <nick@ccl4.org>2012-08-14 10:12:58 +0200
commit0fc4714aa17fcb440e297d8a2798e956eed9ca21 (patch)
tree6fed8a6f697ed9ece5c248217b74c725e860c7f5 /ext/XS-APItest
parentc0810f8ef849bf940e296c00ef5a0c1bd77f9c62 (diff)
downloadperl-0fc4714aa17fcb440e297d8a2798e956eed9ca21.tar.gz
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.
Diffstat (limited to 'ext/XS-APItest')
-rw-r--r--ext/XS-APItest/APItest.xs4
-rw-r--r--ext/XS-APItest/t/newCONSTSUB.t33
2 files changed, 34 insertions, 3 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index dff9b46b2f..0979aee231 100644
--- 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 e90cfe0f79..2df850e0c0 100644
--- 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');
+}