Tying $_ in @INC filter

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.

diff --git a/pp_ctl.c b/pp_ctl.c
index aa11d58..6b00ec8 100644 (file)
--- 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 (file)
--- 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