pp_match(): refactor intuit-only code

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index ef539d1..f6965da 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1439,13 +1439,27 @@ PP(pp_match)
 
        if (!s)
            goto nope;
-#ifdef PERL_SAWAMPERSAND
        if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-            && !PL_sawampersand
-            && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
             && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
+        {
+            assert(!RX_NPARENS(rx));
+            /* match via INTUIT shouldn't have any captures.
+             * Let @-, @+, $^N know */
+            RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;
+            RX_MATCH_UTF8_set(rx, cBOOL(DO_UTF8(rx)));
+            if ( !(r_flags & REXEC_NOT_FIRST) )
+                Perl_reg_set_capture_string(aTHX_ rx,
+                                        (char*)truebase, (char *)strend,
+                                        TARG, r_flags, cBOOL(DO_UTF8(TARG)));
+
+            /* skipping regexec means that indices for $&, $-[0] etc not set */
+            RX_OFFS(rx)[0].start = s - truebase;
+            RX_OFFS(rx)[0].end =
+                RX_MATCH_UTF8(rx)
+                    ? (char*)utf8_hop((U8*)s, RX_MINLENRET(rx)) - truebase
+                    : s - truebase + RX_MINLENRET(rx);
            goto yup;
-#endif
+        }
     }
     if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase,
                     minmatch, TARG, NUM2PTR(void*, gpos), r_flags))
@@ -1464,7 +1478,29 @@ PP(pp_match)
     if (rxtainted)
        RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
-    if (gimme == G_ARRAY) {
+
+    /* update pos */
+
+    if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
+        MAGIC *mg = mg_find_mglob(TARG);
+        if (!mg) {
+            mg = sv_magicext_mglob(TARG);
+        }
+        if (RX_OFFS(rx)[0].start != -1) {
+            mg->mg_len = RX_OFFS(rx)[0].end;
+            if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
+                mg->mg_flags |= MGf_MINMATCH;
+            else
+                mg->mg_flags &= ~MGf_MINMATCH;
+        }
+    }
+
+    if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) {
+       LEAVE_SCOPE(oldsave);
+       RETPUSHYES;
+    }
+
+    {
        const I32 nparens = RX_NPARENS(rx);
        I32 i = (global && !nparens) ? 1 : 0;
 
@@ -1488,19 +1524,6 @@ PP(pp_match)
            }
        }
        if (global) {
-           if (dynpm->op_pmflags & PMf_CONTINUE) {
-               MAGIC *mg = mg_find_mglob(TARG);
-               if (!mg) {
-                   mg = sv_magicext_mglob(TARG);
-               }
-               if (RX_OFFS(rx)[0].start != -1) {
-                   mg->mg_len = RX_OFFS(rx)[0].end;
-                   if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
-                       mg->mg_flags |= MGf_MINMATCH;
-                   else
-                       mg->mg_flags &= ~MGf_MINMATCH;
-               }
-           }
            had_zerolen = (RX_OFFS(rx)[0].start != -1
                           && (RX_OFFS(rx)[0].start + RX_GOFS(rx)
                               == (UV)RX_OFFS(rx)[0].end));
@@ -1508,32 +1531,11 @@ PP(pp_match)
            r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
            goto play_it_again;
        }
-       else if (!nparens)
-           XPUSHs(&PL_sv_yes);
        LEAVE_SCOPE(oldsave);
        RETURN;
     }
-    else {
-       if (global) {
-           MAGIC *mg = mg_find_mglob(TARG);
-           if (!mg) {
-               mg = sv_magicext_mglob(TARG);
-           }
-           if (RX_OFFS(rx)[0].start != -1) {
-               mg->mg_len = RX_OFFS(rx)[0].end;
-               if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
-                   mg->mg_flags |= MGf_MINMATCH;
-               else
-                   mg->mg_flags &= ~MGf_MINMATCH;
-           }
-       }
-       LEAVE_SCOPE(oldsave);
-       RETPUSHYES;
-    }
 
-#ifdef PERL_SAWAMPERSAND
 yup:                                   /* Confirmed by INTUIT */
-#endif
     if (rxtainted)
        RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
@@ -1545,68 +1547,12 @@ yup:                                    /* Confirmed by INTUIT */
         dynpm->op_pmflags |= PMf_USED;
 #endif
     }
-    if (RX_MATCH_COPIED(rx))
-       Safefree(RX_SUBBEG(rx));
-    RX_MATCH_COPIED_off(rx);
-    RX_SUBBEG(rx) = NULL;
+
+
     if (global) {
-       /* FIXME - should rx->subbeg be const char *?  */
-       RX_SUBBEG(rx) = (char *) truebase;
-       RX_SUBOFFSET(rx) = 0;
-       RX_SUBCOFFSET(rx) = 0;
-       RX_OFFS(rx)[0].start = s - truebase;
-       if (RX_MATCH_UTF8(rx)) {
-           char * const t = (char*)utf8_hop((U8*)s, RX_MINLENRET(rx));
-           RX_OFFS(rx)[0].end = t - truebase;
-       }
-       else {
-           RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
-       }
-       RX_SUBLEN(rx) = strend - truebase;
        goto gotcha;
     }
-#ifdef PERL_SAWAMPERSAND
-    if (PL_sawampersand || RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
-#endif
-    {
-       I32 off;
-#ifdef PERL_ANY_COW
-       if (SvCANCOW(TARG)) {
-           if (DEBUG_C_TEST) {
-               PerlIO_printf(Perl_debug_log,
-                             "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n",
-                             (int) SvTYPE(TARG), (void*)truebase, (void*)t,
-                             (int)(t-truebase));
-           }
-           RX_SAVED_COPY(rx) = sv_setsv_cow(RX_SAVED_COPY(rx), TARG);
-           RX_SUBBEG(rx)
-               = (char *) SvPVX_const(RX_SAVED_COPY(rx)) + (t - truebase);
-           assert (SvPOKp(RX_SAVED_COPY(rx)));
-       } else
-#endif
-       {
 
-           RX_SUBBEG(rx) = savepvn(t, strend - t);
-#ifdef PERL_ANY_COW
-           RX_SAVED_COPY(rx) = NULL;
-#endif
-       }
-       RX_SUBLEN(rx) = strend - t;
-       RX_SUBOFFSET(rx) = 0;
-       RX_SUBCOFFSET(rx) = 0;
-       RX_MATCH_COPIED_on(rx);
-       off = RX_OFFS(rx)[0].start = s - t;
-       RX_OFFS(rx)[0].end = off + RX_MINLENRET(rx);
-    }
-#ifdef PERL_SAWAMPERSAND
-    else {                     /* startp/endp are used by @- @+. */
-       RX_OFFS(rx)[0].start = s - truebase;
-       RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
-    }
-#endif
-    /* match via INTUIT shouldn't have any captures. Let @-, @+, $^N know */
-    assert(!RX_NPARENS(rx));
-    RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
@@ -2022,8 +1968,12 @@ PP(pp_iter)
                 *itersvp = NULL;
                 Perl_croak(aTHX_ "Use of freed value in iteration");
             }
-            SvTEMP_off(sv);
-            SvREFCNT_inc_simple_void_NN(sv);
+            if (SvPADTMP(sv) && !IS_PADGV(sv))
+                sv = newSVsv(sv);
+            else {
+                SvTEMP_off(sv);
+                SvREFCNT_inc_simple_void_NN(sv);
+            }
         }
         else
             sv = &PL_sv_undef;