In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/b6f3718f1b3218256c962a8f46e747048228d196?hp=ca84e88ece180337b1ea0b8a2b9d4211b1089878>
- Log ----------------------------------------------------------------- commit b6f3718f1b3218256c962a8f46e747048228d196 Author: Zefram <[email protected]> Date: Mon Nov 13 13:30:36 2017 +0000 localise $@ around source filters $@ could be clobbered by source filters, screwing up the reporting of errors in the filtered source. Prevent this by localising $@ around each call to a source filter. Fixes [perl #38920]. ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + t/comp/filter_exception.t | 32 ++++++++++++++++++++++++++++++++ t/porting/test_bootstrap.t | 1 + toke.c | 7 ++++++- 4 files changed, 40 insertions(+), 1 deletion(-) create mode 100644 t/comp/filter_exception.t diff --git a/MANIFEST b/MANIFEST index 7df52ed8c9..6caab5a709 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5372,6 +5372,7 @@ t/comp/bproto.t See if builtins conform to their prototypes t/comp/cmdopt.t See if command optimization works t/comp/colon.t See if colons are parsed correctly t/comp/decl.t See if declarations work +t/comp/filter_exception.t See if $@ survives source filters t/comp/final_line_num.t See if line numbers are correct at EOF t/comp/fold.t See if constant folding works t/comp/form_scope.t See if format scoping works diff --git a/t/comp/filter_exception.t b/t/comp/filter_exception.t new file mode 100644 index 0000000000..ea0e9d7c2c --- /dev/null +++ b/t/comp/filter_exception.t @@ -0,0 +1,32 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; +} + +plan tests => 4; + +BEGIN { + unshift @INC, sub { + return () unless $_[1] =~ m#\At/(Foo|Bar)\.pm\z#; + my $t = 0; + return sub { + if(!$t) { + $_ = "int(1,2);\n"; + $t = 1; + $@ = "wibble"; + return 1; + } else { + return 0; + } + }; + }; +} + +is +(do "t/Bar.pm"), undef; +like $@, qr/\AToo many arguments for int /; +is eval { require "t/Foo.pm" }, undef; +like $@, qr/\AToo many arguments for int /; + +1; diff --git a/t/porting/test_bootstrap.t b/t/porting/test_bootstrap.t index 6888daa921..03a9a8ce83 100644 --- a/t/porting/test_bootstrap.t +++ b/t/porting/test_bootstrap.t @@ -18,6 +18,7 @@ open my $fh, '<', '../MANIFEST' or die "Can't open MANIFEST: $!"; # Some tests in t/comp need to use require or use to get their job done: my %exceptions = ( + filter_exception => "require './test.pl'", hints => "require './test.pl'", parser => 'use DieDieDie', parser_run => "require './test.pl'", diff --git a/toke.c b/toke.c index 4cdfcea7d9..f94c0d58fd 100644 --- a/toke.c +++ b/toke.c @@ -4499,6 +4499,7 @@ I32 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) { filter_t funcp; + I32 ret; SV *datasv = NULL; /* This API is bad. It should have been using unsigned int for maxlen. Not sure if we want to change the API, but if not we should sanity @@ -4581,7 +4582,11 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ - return (*funcp)(aTHX_ idx, buf_sv, correct_length); + ENTER; + save_scalar(PL_errgv); + ret = (*funcp)(aTHX_ idx, buf_sv, correct_length); + LEAVE; + return ret; } STATIC char * -- Perl5 Master Repository
