From d34a666494db40538f88613ec991214f3a862865 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 30 May 2011 08:55:40 -0700
Subject: [PATCH] [perl #91880] $_ refcounting problems in @INC filters
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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).
---
 pp_ctl.c         |  4 +++-
 t/op/incfilter.t | 22 +++++++++++++++++++++-
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 0df8b5f..16386a8 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -5232,6 +5232,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) {
@@ -5243,11 +5244,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 74675a2..9db4f7d 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';
+}
-- 
2.7.4