diff options
author | Nicholas Clark <nick@ccl4.org> | 2012-08-13 15:11:41 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2012-08-14 10:12:58 +0200 |
commit | 0fc4714aa17fcb440e297d8a2798e956eed9ca21 (patch) | |
tree | 6fed8a6f697ed9ece5c248217b74c725e860c7f5 /ext/XS-APItest | |
parent | c0810f8ef849bf940e296c00ef5a0c1bd77f9c62 (diff) | |
download | perl-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.xs | 4 | ||||
-rw-r--r-- | ext/XS-APItest/t/newCONSTSUB.t | 33 |
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'); +} |