Revert "Gut Perl_save_re_context"
authorDavid Mitchell <davem@iabyn.com>
Wed, 25 Mar 2015 16:21:31 +0000 (16:21 +0000)
committerDavid Mitchell <davem@iabyn.com>
Mon, 30 Mar 2015 11:05:23 +0000 (12:05 +0100)
This reverts commit b4fa55d3f12c6d98b13a8b3db4f8d921c8e56edc.

Turns out we need Perl_save_re_context() after all

regcomp.c

index 40336bf..7bf6307 100644 (file)
--- 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