summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-05-30 08:55:40 -0700
committerFlorian Ragwitz <rafl@debian.org>2011-08-26 11:35:57 +0200
commit029baf2e25604d42435efa9dfeaa06ea381302c3 (patch)
tree04b87a8284a1d092d55118a491e2d74ed8b66a0c
parent5d45b5295de11d202fbf843be3c13f54bb0c07f7 (diff)
downloadperl-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.c4
-rw-r--r--t/op/incfilter.t22
2 files changed, 24 insertions, 2 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index 28e258b7ed..d6b59ad833 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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';
+}