From 536ac391fe10ec8bed2037ca93dd5044c83eac16 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 9 Aug 2013 08:42:32 -0700
Subject: [PATCH] Tying $_ in @INC filter
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Crazy?  Probably.  But the existing code partially handles magic val-
ues already; it’s just buggy.  Also, the magic value could come from
another source filter that is not registered via @INC, and this is one
way to test that code path.
---
 pp_ctl.c         |  8 ++++++--
 t/op/incfilter.t | 13 ++++++++++++-
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index aa11d58..6b00ec8 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -5458,9 +5458,13 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	LEAVE_with_name("call_filter_sub");
     }
 
+    if (SvGMAGICAL(upstream)) {
+	mg_get(upstream);
+	if (upstream == buf_sv) mg_free(buf_sv);
+    }
     if (SvIsCOW(upstream)) sv_force_normal(upstream);
     if(!err && SvOK(upstream)) {
-	got_p = SvPV(upstream, got_len);
+	got_p = SvPV_nomg(upstream, got_len);
 	if (umaxlen) {
 	    if (got_len > umaxlen) {
 		prune_from = got_p + umaxlen;
@@ -5504,7 +5508,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     */
     if (!err && upstream != buf_sv &&
         (SvOK(upstream) || SvGMAGICAL(upstream))) {
-	sv_catsv(buf_sv, upstream);
+	sv_catsv_nomg(buf_sv, upstream);
     }
     else if (SvOK(upstream)) (void)SvPV_force_nolen(buf_sv);
 
diff --git a/t/op/incfilter.t b/t/op/incfilter.t
index 8a3fd63..767aa12 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 => 150);
+plan(tests => 151);
 
 unshift @INC, sub {
     no warnings 'uninitialized';
@@ -245,6 +245,17 @@ like ${$::{the_array}}, qr/^ARRAY\(0x.*\)\z/,
 do \&generator or die;
 is ${$::{the_array}}, "*main::foo", 'setting $_ to glob in inc filter';
 
+sub TIESCALAR { bless \(my $thing = pop), shift }
+sub FETCH {${$_[0]}}
+my $done;
+do sub {
+    return 0 if $done;
+    tie $_, "main", '$::the_scalar = 98732';
+    return $done = 1;
+} or die;
+is ${$::{the_scalar}}, 98732, 'tying $_ in inc filter';
+
+
 # d8723a6a74b2c12e wasn't perfect, as the char * returned by SvPV*() can be
 # a temporary, freed at the next FREETMPS. And there is a FREETMPS in
 # pp_require
-- 
1.8.3.1