Chip noticed that the intended optionality of the 'IV' was

[p5sagit/p5-mst-13.2.git] / regexec.c

diff --git a/regexec.c b/regexec.c
index ee53a47..4135d36 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -97,7 +97,6 @@
 #endif
 
 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
-#define REGINCLASS_utf8(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c,0,1) : ANYOF_BITMAP_TEST(p,*(c)))
 
 /*
  * Forwards.
@@ -401,6 +400,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     char *i_strpos = strpos;
     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
 #endif
+    RX_MATCH_UTF8_set(prog,do_utf8);
 
     if (prog->reganch & ROPT_UTF8) {
        DEBUG_r(PerlIO_printf(Perl_debug_log,
@@ -856,6 +856,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            PL_regdata = prog->data;
            PL_bostr = startpos;
        }
+       cache_re(prog);
        s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
        if (!s) {
 #ifdef DEBUGGING
@@ -1616,6 +1617,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
 #endif
+    RX_MATCH_UTF8_set(prog,do_utf8);
 
     PL_regcc = 0;
 
@@ -2021,17 +2023,28 @@ got_it:
 
     /* make sure $`, $&, $', and $digit will work later */
     if ( !(flags & REXEC_NOT_FIRST) ) {
-       if (RX_MATCH_COPIED(prog)) {
-           Safefree(prog->subbeg);
-           RX_MATCH_COPIED_off(prog);
-       }
+       RX_MATCH_COPY_FREE(prog);
        if (flags & REXEC_COPY_STR) {
            I32 i = PL_regeol - startpos + (stringarg - strbeg);
-
-           s = savepvn(strbeg, i);
-           prog->subbeg = s;
+#ifdef PERL_COPY_ON_WRITE
+           if ((SvIsCOW(sv)
+                || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
+               if (DEBUG_C_TEST) {
+                   PerlIO_printf(Perl_debug_log,
+                                 "Copy on write: regexp capture, type %d\n",
+                                 (int) SvTYPE(sv));
+               }
+               prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
+               prog->subbeg = SvPVX(prog->saved_copy);
+               assert (SvPOKp(prog->saved_copy));
+           } else
+#endif
+           {
+               RX_MATCH_COPIED_on(prog);
+               s = savepvn(strbeg, i);
+               prog->subbeg = s;
+           }
            prog->sublen = i;
-           RX_MATCH_COPIED_on(prog);
        }
        else {
            prog->subbeg = strbeg;
@@ -2121,6 +2134,9 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
                $` inside (?{}) could fail... */
            PL_reg_oldsaved = prog->subbeg;
            PL_reg_oldsavedlen = prog->sublen;
+#ifdef PERL_COPY_ON_WRITE
+           PL_nrs = prog->saved_copy;
+#endif
            RX_MATCH_COPIED_off(prog);
        }
        else
@@ -4078,9 +4094,8 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     case ANYOF:
        if (do_utf8) {
            loceol = PL_regeol;
-           while (hardcount < max && scan < loceol) {
-               if (!REGINCLASS_utf8(p, (U8*)scan))
-                       break;
+           while (hardcount < max && scan < loceol &&
+                  reginclass(p, (U8*)scan, 0, do_utf8)) {
                scan += UTF8SKIP(scan);
                hardcount++;
            }
@@ -4554,6 +4569,9 @@ restore_pos(pTHX_ void *arg)
        if (PL_reg_oldsaved) {
            PL_reg_re->subbeg = PL_reg_oldsaved;
            PL_reg_re->sublen = PL_reg_oldsavedlen;
+#ifdef PERL_COPY_ON_WRITE
+           PL_reg_re->saved_copy = PL_nrs;
+#endif
            RX_MATCH_COPIED_on(PL_reg_re);
        }
        PL_reg_magic->mg_len = PL_reg_oldpos;