Setting $_ to multiline glob in @INC filter

This commit corrects the one remaining code path in
pp_ctl.c:S_run_user_filter that was not handling non-PVs.

If we have to truncate $_ and keep the remainder in a cache (because
it has more than one line), we need to make sure we don’t assume it is
a PV when it comes to truncating it.

$ ./perl -Ilib -e '@INC = sub { sub { return 0 if $|--; $_ = *{"foo;\nbar"}; return 1 } }; do "foo"'
Assertion failed: (!isGV_with_GP(upstream)), function S_run_user_filter, file pp_ctl.c, line 5494.
Abort trap: 6

diff --git a/pp_ctl.c b/pp_ctl.c
index 6b00ec8..1998816 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -5495,7 +5495,12 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        if (SvUTF8(upstream)) {
            SvUTF8_on(cache);
        }
-       SvCUR_set(upstream, got_len - cached_len);
+       if (SvPOK(upstream)) SvCUR_set(upstream, got_len - cached_len);
+       else
+           /* Cannot just use sv_setpvn, as that could free the buffer
+              before we have a chance to assign it. */
+           sv_usepvn(upstream, savepvn(got_p, got_len - cached_len),
+                     got_len - cached_len);
        *prune_from = 0;
        /* Can't yet be EOF  */
        if (status == 0)

diff --git a/t/op/incfilter.t b/t/op/incfilter.t
index c690970..b8efb9b 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 => 151);
+plan(tests => 152);
 
 unshift @INC, sub {
     no warnings 'uninitialized';
@@ -244,6 +244,13 @@ like ${$::{the_array}}, qr/^ARRAY\(0x.*\)\z/,
 @lines = ('$::the_array = "', do { no warnings 'once'; *foo}, '"');
 do \&generator or die;
 is ${$::{the_array}}, "*main::foo", 'setting $_ to glob in inc filter';
+@lines = (
+    '$::the_array = "',
+     do { no strict; no warnings; *{"foo\nbar"}},
+    '"');
+do \&generator or die;
+is ${$::{the_array}}, "*main::foo\nbar",
+    'setting $_ to multiline glob in inc filter';
 
 sub TIESCALAR { bless \(my $thing = pop), shift }
 sub FETCH {${$_[0]}}