diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-05-30 08:55:40 -0700 |
---|---|---|
committer | Florian Ragwitz <rafl@debian.org> | 2011-08-26 11:35:57 +0200 |
commit | 029baf2e25604d42435efa9dfeaa06ea381302c3 (patch) | |
tree | 04b87a8284a1d092d55118a491e2d74ed8b66a0c | |
parent | 5d45b5295de11d202fbf843be3c13f54bb0c07f7 (diff) | |
download | perl-029baf2e25604d42435efa9dfeaa06ea381302c3.tar.gz |
[perl #91880] $_ refcounting problems in @INC filters
In @INC filters (subs returned by subs in @INC), $_ is localised to a
variable to which the next line of source code is to be assigned. The
function in pp_ctl.c that calls it (S_run_user_filter) has a pointer
to that variable.
Up till now, it was not setting the refcount or localising
$_ properly.
‘undef *_’ inside the sub would destroy the only refcount it
had, leaving a freed sv for toke.c to parse (which would crash,
of course).
In some cases, S_run_user_filter has to created a new variable. In
those cases, it was setting $_ to a mortal variable with the TEMP
flag, but with a refcount of 1, which would result in ‘Attempt to free
unreferenced scalar’ warnings if the $_ were freed by the subroutine.
This commit changes S_run_user_filter to use SAVEGENERICSV, rather
than SAVE_DEFSV, to localise $_, since the former lowers the refcount
on scope exit, while the latter does not. So now I have also made it
increase the refcount after assigning to the now-properly-localised $_
(DEFSV). I also turned off the TEMP flag, to avoid weird side effects
(which were what led me to this bug to begin with).
-rw-r--r-- | pp_ctl.c | 4 | ||||
-rw-r--r-- | t/op/incfilter.t | 22 |
2 files changed, 24 insertions, 2 deletions
@@ -5240,6 +5240,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) I'm going to use a mortal in case the upstream filter croaks. */ upstream = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv)) ? sv_newmortal() : buf_sv; + SvTEMP_off(upstream); SvUPGRADE(upstream, SVt_PV); if (filter_has_file) { @@ -5251,11 +5252,12 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) int count; ENTER_with_name("call_filter_sub"); - SAVE_DEFSV; + SAVEGENERICSV(GvSV(PL_defgv)); SAVETMPS; EXTEND(SP, 2); DEFSV_set(upstream); + SvREFCNT_inc_simple_void_NN(upstream); PUSHMARK(SP); mPUSHi(0); if (filter_state) { diff --git a/t/op/incfilter.t b/t/op/incfilter.t index 74675a2c12..9db4f7d21b 100644 --- a/t/op/incfilter.t +++ b/t/op/incfilter.t @@ -13,7 +13,7 @@ use strict; use Config; use Filter::Util::Call; -plan(tests => 143); +plan(tests => 145); unshift @INC, sub { no warnings 'uninitialized'; @@ -227,3 +227,23 @@ for (0 .. 1) { \'like(__FILE__, qr/(?:GLOB|CODE)\(0x[0-9a-f]+\)/, "__FILE__ is valid");'; do $fh or die; } + +# [perl #91880] $_ marked TEMP or having the wrong refcount inside a +{ # filter sub + local @INC; local $|; + unshift @INC, sub { sub { undef *_; --$| }}; + do "dah"; + pass '$_ has the right refcount inside a filter sub'; + + my $temps = 0; + @INC = sub { sub { + my $temp = \sub{$_}->(); + $temps++ if $temp == \$_; + $_ = "a" unless $|; + return --$| + }}; + local $^W; + do "dah"; + + is $temps, 0, '$_ is not marked TEMP'; +} |