summaryrefslogtreecommitdiff
path: root/regcomp.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2015-03-25 16:21:31 +0000
committerDavid Mitchell <davem@iabyn.com>2015-03-30 12:05:23 +0100
commite8d8f801f452fb6a459fa7375ce32ec55300a01d (patch)
tree4f5eac8f0f345d79d33a0bf26a6b0115b839f4de /regcomp.c
parent2782061f5102a81e1eae39cce864ce172fbea63d (diff)
downloadperl-e8d8f801f452fb6a459fa7375ce32ec55300a01d.tar.gz
Revert "Gut Perl_save_re_context"
This reverts commit b4fa55d3f12c6d98b13a8b3db4f8d921c8e56edc. Turns out we need Perl_save_re_context() after all
Diffstat (limited to 'regcomp.c')
-rw-r--r--regcomp.c24
1 files changed, 21 insertions, 3 deletions
diff --git a/regcomp.c b/regcomp.c
index 40336bf5f9..7bf630792b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -17711,14 +17711,32 @@ S_re_croak2(pTHX_ bool utf8, const char* pat1,const char* pat2,...)
Perl_croak(aTHX_ "%"UTF8f, UTF8fARG(utf8, l1-1, buf));
}
-/* Get this: We have an empty void function here. But it somehow got into
- the API, so there you go. */
+/* XXX Here's a total kludge. But we need to re-enter for swash routines. */
#ifndef PERL_IN_XSUB_RE
void
Perl_save_re_context(pTHX)
{
- PERL_UNUSED_CONTEXT;
+ /* 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);
+ }
+ }
+ }
+ }
}
#endif