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].

diff --git a/MANIFEST b/MANIFEST
index 7df52ed..6caab5a 100644 (file)
--- 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 (file)
index 0000000..ea0e9d7
--- /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 6888daa..03a9a8c 100644 (file)
--- 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 4cdfcea..f94c0d5 100644 (file)
--- 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 *