diff options
author | Father Chrysostomos <sprout@cpan.org> | 2013-08-08 12:49:57 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2013-08-11 07:50:22 -0700 |
commit | ae2c96eda1df76d1bf5fba543a6ebfc266fdd824 (patch) | |
tree | cbdeca63513779b49b644e710711cb595345527a | |
parent | 54ac81a4f8dd759b88b5a5104af99f6af2814215 (diff) | |
download | perl-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.c | 1 | ||||
-rw-r--r-- | t/op/incfilter.t | 10 |
2 files changed, 10 insertions, 1 deletions
@@ -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 |