In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1a419e6b1ae911c99a8ca065071290a8ba070856?hp=57ae61efb92039dfd13bb45ab5540e9b646a8cf5>
- Log ----------------------------------------------------------------- commit 1a419e6b1ae911c99a8ca065071290a8ba070856 Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 16:34:40 2014 -0700 utf8.c: Move an #ifndef for clarity The comment really belongs inside it, as it refers to those two lines of code. M utf8.c commit 1ca1baeff524e5f0398b23e9f8ba173cec7d497e Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 16:33:54 2014 -0700 Remove obsolete comment from utf8.c The call to save_re_context was removed by the previous commit. The commit before that stopped save_re_context from doing anything. Commit db2c6cb33 stopped the errsv_save line from triggering get-magic. So this comment, added in dc0c6abb4, no longer applies. M utf8.c commit d28a9254e445aee7212523d9a7ff62ae0a743fec Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 16:22:03 2014 -0700 Donât call save_re_context It is an empty function. M mg.c M regcomp.c M sv.c M utf8.c M util.c commit b4fa55d3f12c6d98b13a8b3db4f8d921c8e56edc Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 15:39:39 2014 -0700 Gut Perl_save_re_context What it does is not longer necessary. See ticket #122747 and commits 2c1f00b90 and 7d75537e. The only CPAN module using this function, XML::Fast, passes its tests with this change. M regcomp.c ----------------------------------------------------------------------- Summary of changes: mg.c | 1 - regcomp.c | 25 +++---------------------- sv.c | 2 -- utf8.c | 7 +------ util.c | 1 - 5 files changed, 4 insertions(+), 32 deletions(-) diff --git a/mg.c b/mg.c index 9dc0679..01fa6b4 100644 --- a/mg.c +++ b/mg.c @@ -1759,7 +1759,6 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, if (flags & G_WRITING_TO_STDERR) { SAVETMPS; - save_re_context(); SAVESPTR(PL_stderrgv); PL_stderrgv = NULL; } diff --git a/regcomp.c b/regcomp.c index 726a655..a3eccfa 100644 --- a/regcomp.c +++ b/regcomp.c @@ -6054,7 +6054,6 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, ENTER; SAVETMPS; - save_re_context(); PUSHSTACKi(PERLSI_REQUIRE); /* G_RE_REPARSING causes the toker to collapse \\ into \ when * parsing qr''; normally only q'' does this. It also alters @@ -16786,32 +16785,14 @@ S_re_croak2(pTHX_ bool utf8, const char* pat1,const char* pat2,...) Perl_croak(aTHX_ "%"UTF8f, UTF8fARG(utf8, l1-1, buf)); } -/* XXX Here's a total kludge. But we need to re-enter for swash routines. */ +/* Get this: We have an empty void function here. But it somehow got into + the API, so there you go. */ #ifndef PERL_IN_XSUB_RE void Perl_save_re_context(pTHX) { - /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */ - if (PL_curpm) { - const REGEXP * const rx = PM_GETRE(PL_curpm); - if (rx) { - U32 i; - for (i = 1; i <= RX_NPARENS(rx); i++) { - char digits[TYPE_CHARS(long)]; - const STRLEN len = my_snprintf(digits, sizeof(digits), - "%lu", (long)i); - GV *const *const gvp - = (GV**)hv_fetch(PL_defstash, digits, len, 0); - - if (gvp) { - GV * const gv = *gvp; - if (SvTYPE(gv) == SVt_PVGV && GvSV(gv)) - save_scalar(gv); - } - } - } - } + PERL_UNUSED_CONTEXT; } #endif diff --git a/sv.c b/sv.c index c71f5c5..1ae347a 100644 --- a/sv.c +++ b/sv.c @@ -14875,7 +14875,6 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding) nsv = sv_newmortal(); SvSetSV_nosteal(nsv, sv); } - save_re_context(); PUSHMARK(sp); EXTEND(SP, 3); PUSHs(encoding); @@ -14946,7 +14945,6 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding, dSP; ENTER; SAVETMPS; - save_re_context(); PUSHMARK(sp); EXTEND(SP, 6); PUSHs(encoding); diff --git a/utf8.c b/utf8.c index a59445e..a7baed4 100644 --- a/utf8.c +++ b/utf8.c @@ -2357,7 +2357,6 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m PUSHSTACKi(PERLSI_MAGIC); ENTER; SAVEHINTS(); - save_re_context(); /* We might get here via a subroutine signature which uses a utf8 * parameter name, at which point PL_subname will have been set * but not yet used. */ @@ -2369,13 +2368,9 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m ENTER; if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save); GvSV(PL_errgv) = NULL; +#ifndef NO_TAINT_SUPPORT /* It is assumed that callers of this routine are not passing in * any user derived data. */ - /* Need to do this after save_re_context() as it will set - * PL_tainted to 1 while saving $1 etc (see the code after getrx: - * in Perl_magic_get). Even line to create errsv_save can turn on - * PL_tainted. */ -#ifndef NO_TAINT_SUPPORT SAVEBOOL(TAINT_get); TAINT_NOT; #endif diff --git a/util.c b/util.c index dea60ac..d6501bd 100644 --- a/util.c +++ b/util.c @@ -1533,7 +1533,6 @@ S_invoke_exception_hook(pTHX_ SV *ex, bool warn) SV *exarg; ENTER; - save_re_context(); if (warn) { SAVESPTR(*hook); *hook = NULL; -- Perl5 Master Repository
