summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-08-08 12:49:57 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-08-11 07:50:22 -0700
commitae2c96eda1df76d1bf5fba543a6ebfc266fdd824 (patch)
treecbdeca63513779b49b644e710711cb595345527a
parent54ac81a4f8dd759b88b5a5104af99f6af2814215 (diff)
downloadperl-ae2c96eda1df76d1bf5fba543a6ebfc266fdd824.tar.gz
Handle non-PV $_ in @INC filters
@INC filters (code refs returned by code refs in @INC) are given the current line of code in $_ and can modify it. The C code that invokes the Perl filter is in pp_ctl.c:S_run_user_filter. It was not taking into account that $_ might not have a PV pointer when it is returned, and so this could result in crashes or assertion failures. This commit forces the scalar to be a string before returning it to the lexer, unless it is undef. If we force it to be a string when it is undef, then existing tests start producing uninitialized warnings. The logic is still faulty in places. Subsequent commits will address that.
-rw-r--r--pp_ctl.c1
-rw-r--r--t/op/incfilter.t10
2 files changed, 10 insertions, 1 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index 85149fe2f3..aa11d58872 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -5506,6 +5506,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
(SvOK(upstream) || SvGMAGICAL(upstream))) {
sv_catsv(buf_sv, upstream);
}
+ else if (SvOK(upstream)) (void)SvPV_force_nolen(buf_sv);
if (status <= 0) {
IoLINES(datasv) = 0;
diff --git a/t/op/incfilter.t b/t/op/incfilter.t
index e07526c2fb..8a3fd63d5a 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 => 148);
+plan(tests => 150);
unshift @INC, sub {
no warnings 'uninitialized';
@@ -237,6 +237,14 @@ do [\'pa', \&generator_with_state,
do \&generator or die;
is $origlines[0], "1\n+\n2\n", 'ink filters do not mangle cow buffers';
+@lines = ('$::the_array = "', [], '"');
+do \&generator or die;
+like ${$::{the_array}}, qr/^ARRAY\(0x.*\)\z/,
+ 'setting $_ to ref in inc filter';
+@lines = ('$::the_array = "', *foo, '"');
+do \&generator or die;
+is ${$::{the_array}}, "*main::foo", 'setting $_ to glob 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