From 27fcb6ee0bb7765fc92447e27763fa4ab7ae9baa Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 29 Mar 2011 08:33:30 -0700 Subject: [PATCH] [perl #87064] eval no longer shares filters Before this commit: commit f07ec6dd59215a56bc1159449a9631be7a02a94d Author: Zefram 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. --- MANIFEST | 1 + ext/XS-APItest/APItest.pm | 7 ++++++- ext/XS-APItest/APItest.xs | 25 +++++++++++++++++++++++++ ext/XS-APItest/t/eval-filter.t | 10 ++++++++++ op.c | 2 +- parser.h | 3 +++ pp_ctl.c | 4 ++-- toke.c | 13 ++++++++++--- 8 files changed, 58 insertions(+), 7 deletions(-) create mode 100644 ext/XS-APItest/t/eval-filter.t diff --git a/MANIFEST b/MANIFEST index 5dcb889..27a9e75 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3633,6 +3633,7 @@ ext/XS-APItest/t/cleanup.t test stack behaviour on unwinding ext/XS-APItest/t/cophh.t test COPHH API ext/XS-APItest/t/copyhints.t test hv_copy_hints_hv() API ext/XS-APItest/t/customop.t XS::APItest: tests for custom ops +ext/XS-APItest/t/eval-filter.t Simple source filter/eval test ext/XS-APItest/t/exception.t XS::APItest extension ext/XS-APItest/t/grok.t XS::APItest: tests for grok* functions ext/XS-APItest/t/hash.t XS::APItest: tests for hash related APIs diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index b95af26..5ef9ea2 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. Output is sent to STDOUT. +=item B + +Installs a source filter that substitutes "e" for "o" (witheut regard fer +what it might be medifying). + =item B, B, B 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 0ce4d51..4fa4e1e 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 0000000..8d370e5 --- /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]. diff --git a/op.c b/op.c index 2e15a8d..e917d43 100644 --- a/op.c +++ b/op.c @@ -4453,7 +4453,7 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) ENTER; SAVEVPTR(PL_curcop); - lex_start(NULL, NULL, 0); + lex_start(NULL, NULL, LEX_START_SAME_FILTER); utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), veop, modname, imop); LEAVE; diff --git a/parser.h b/parser.h index e4a06dc..17ced8f 100644 --- a/parser.h +++ b/parser.h @@ -112,6 +112,9 @@ typedef struct yy_parser { /* flags for lexer API */ #define LEX_STUFF_UTF8 0x00000001 #define LEX_KEEP_PREVIOUS 0x00000002 +#ifdef PERL_CORE +# define LEX_START_SAME_FILTER 0x00000001 +#endif /* flags for parser API */ #define PARSE_OPTIONAL 0x00000001 diff --git a/pp_ctl.c b/pp_ctl.c index 44cf3c1..aabbcd3 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3090,7 +3090,7 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code, PERL_ARGS_ASSERT_SV_COMPILE_2OP_IS_BROKEN; ENTER_with_name("eval"); - lex_start(sv, NULL, 0); + lex_start(sv, NULL, LEX_START_SAME_FILTER); SAVETMPS; /* switch to eval mode */ @@ -3957,7 +3957,7 @@ PP(pp_entereval) TAINT_PROPER("eval"); ENTER_with_name("eval"); - lex_start(sv, NULL, 0); + lex_start(sv, NULL, LEX_START_SAME_FILTER); SAVETMPS; /* switch to eval mode */ diff --git a/toke.c b/toke.c index 9642ad3..f5f1f8a 100644 --- a/toke.c +++ b/toke.c @@ -667,11 +667,15 @@ code in I comes first and must consist of complete lines of input, and I supplies the remainder of the source. The I parameter is reserved for future use, and must always -be zero. +be zero, except for one flag that is currently reserved for perl's internal +use. =cut */ +/* LEX_START_SAME_FILTER indicates that this is not a new file, so it + can share filters with the current parser. */ + void Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) { @@ -679,7 +683,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) const char *s = NULL; STRLEN len; yy_parser *parser, *oparser; - if (flags) + if (flags && flags != LEX_START_SAME_FILTER) Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start"); /* create and initialise a parser */ @@ -708,7 +712,10 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) parser->lex_state = LEX_NORMAL; parser->expect = XSTATE; parser->rsfp = rsfp; - parser->rsfp_filters = newAV(); + parser->rsfp_filters = + !(flags & LEX_START_SAME_FILTER) || !oparser + ? newAV() + : MUTABLE_AV(SvREFCNT_inc(oparser->rsfp_filters)); Newx(parser->lex_brackstack, 120, char); Newx(parser->lex_casestack, 12, char); -- 2.7.4