[perl #87064] eval no longer shares filters

Before this commit:

commit f07ec6dd59215a56bc1159449a9631be7a02a94d
Author: Zefram <zefram@fysh.org>
Date:   Wed Oct 13 19:05:19 2010 +0100

    remove filter inheritance option from lex_start

    The only uses of lex_start that had the new_filter parameter false,
    to make the new lexer context share source filters with the previous
    lexer context, were uses with rsfp null, which therefore never invoked
    source filters.  Inheriting source filters from a logically unrelated
    file seems like a silly idea anyway.

string evals could inherit the same source filter space as the cur-
rently compiling code. Despite what the quoted commit message says,
sharing source filters allows filters to be inherited in both direc-
tions: A source filter created when the eval is being compiled also
applies to the file with which it is sharing its space.

There are at least 20 CPAN distributions relying on this behaviour
(or, rather, what could be considered a Test::More bug). So this com-
mit restores the source-filter-sharing capability. It does not change
the current API or make public the API for sharing source filters, as
this is supposed to be a temporary stop-gap measure for 5.14.

3 files changed, 41 insertions, 1 deletions

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index b95af26df2..5ef9ea2771 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -50,7 +50,7 @@ sub import {
     }
 }
 
-our $VERSION = '0.27';
+our $VERSION = '0.28';
 
 use vars '$WARNINGS_ON_BOOTSTRAP';
 use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
@@ -209,6 +209,11 @@ correctly by C<printf>.
 
 Output is sent to STDOUT.
 
+=item B<filter>
+
+Installs a source filter that substitutes "e" for "o" (witheut regard fer
+what it might be medifying).
+
 =item B<call_sv>, B<call_pv>, B<call_method>
 
 These exercise the C calls of the same names. Everything after the flags
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 0ce4d513dc..4fa4e1ec63 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -996,6 +996,26 @@ peep_xop(pTHX_ OP *o, OP *oldop)
     av_push(MY_CXT.xop_record, newSVpvf("oldop:%"UVxf, PTR2UV(oldop)));
 }
 
+static I32
+filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
+{
+    SV   *my_sv = FILTER_DATA(idx);
+    char *p;
+    char *end;
+    int n = FILTER_READ(idx + 1, buf_sv, maxlen);
+
+    if (n<=0) return n;
+
+    p = SvPV_force_nolen(buf_sv);
+    end = p + SvCUR(buf_sv);
+    while (p < end) {
+	if (*p == 'o') *p = 'e';
+	p++;
+    }
+    return SvCUR(buf_sv);
+}
+
+
 XS(XS_XS__APItest__XSUB_XS_VERSION_undef);
 XS(XS_XS__APItest__XSUB_XS_VERSION_empty);
 XS(XS_XS__APItest__XSUB_XS_APIVERSION_invalid);
@@ -2750,6 +2770,11 @@ CODE:
     PERL_UNUSED_VAR(items);
     croak("postinc called as a function");
 
+void
+filter()
+CODE:
+    filter_add(filter_call, NULL);
+
 BOOT:
 {
     CV *asscv = get_cv("XS::APItest::postinc", 0);
diff --git a/ext/XS-APItest/t/eval-filter.t b/ext/XS-APItest/t/eval-filter.t
new file mode 100644
index 0000000000..8d370e59a7
--- /dev/null
+++ b/ext/XS-APItest/t/eval-filter.t
@@ -0,0 +1,10 @@
+#!perl -w
+use strict;
+
+use Test::More tests => 1;
+use XS::APItest;
+
+BEGIN { eval "BEGIN{ filter() }" }
+
+is "foo", "fee", "evals share filters with the currently compiling scope";
+# See [perl #87064].