don't copy foreach itervar when no external refs exist

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index d825e64..4fe40cc 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -780,6 +780,16 @@ PP(pp_aassign)
     RETURN;
 }
 
+PP(pp_qr)
+{
+    djSP;
+    register PMOP *pm = cPMOP;
+    SV *rv = sv_newmortal();
+    SV *sv = newSVrv(rv, "Regexp");
+    sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
+    RETURNX(PUSHs(rv));
+}
+
 PP(pp_match)
 {
     djSP; dTARG;
@@ -881,7 +891,7 @@ play_it_again:
                goto nope;
            else if ((rx->reganch & ROPT_CHECK_ALL) && !sawampersand)
                goto yup;
-           if (s && rx->check_offset_max < t - s) {
+           if (s && rx->check_offset_max < s - t) {
                ++BmUSEFUL(rx->check_substr);
                s -= rx->check_offset_max;
            }
@@ -905,7 +915,7 @@ play_it_again:
            rx->float_substr = Nullsv;
        }
     }
-    if (regexec_flags(rx, s, strend, truebase, minmatch,
+    if (CALLREGEXEC(rx, s, strend, truebase, minmatch,
                      screamer, NULL, safebase))
     {
        curpm = pm;
@@ -1447,7 +1457,20 @@ PP(pp_iter)
            STRLEN maxlen;
            char *max = SvPV((SV*)av, maxlen);
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
-               sv_setsv(*cx->blk_loop.itervar, cur);
+#ifndef USE_THREADS                      /* don't risk potential race */
+               if (SvREFCNT(*cx->blk_loop.itervar) == 1) {
+                   /* safe to reuse old SV */
+                   sv_setsv(*cx->blk_loop.itervar, cur);
+               }
+               else 
+#endif
+               {
+                   /* we need a fresh SV every time so that loop body sees a
+                    * completely new SV for closures/references to work as
+                    * they used to */
+                   SvREFCNT_dec(*cx->blk_loop.itervar);
+                   *cx->blk_loop.itervar = newSVsv(cur);
+               }
                if (strEQ(SvPVX(cur), max))
                    sv_setiv(cur, 0); /* terminate next time */
                else
@@ -1459,7 +1482,21 @@ PP(pp_iter)
        /* integer increment */
        if (cx->blk_loop.iterix > cx->blk_loop.itermax)
            RETPUSHNO;
-       sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+
+#ifndef USE_THREADS                      /* don't risk potential race */
+       if (SvREFCNT(*cx->blk_loop.itervar) == 1) {
+           /* safe to reuse old SV */
+           sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+       }
+       else 
+#endif
+       {
+           /* we need a fresh SV every time so that loop body sees a
+            * completely new SV for closures/references to work as they
+            * used to */
+           SvREFCNT_dec(*cx->blk_loop.itervar);
+           *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++);
+       }
        RETPUSHYES;
     }
 
@@ -1617,7 +1654,7 @@ PP(pp_subst)
     /* can do inplace substitution? */
     if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR))
        && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
-       if (!regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+       if (!CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
            SPAGAIN;
            PUSHs(&sv_no);
            LEAVE_SCOPE(oldsave);
@@ -1694,7 +1731,7 @@ PP(pp_subst)
                    d += clen;
                }
                s = rx->endp[0];
-           } while (regexec_flags(rx, s, strend, orig, s == m,
+           } while (CALLREGEXEC(rx, s, strend, orig, s == m,
                              Nullsv, NULL, 0)); /* don't match same null twice */
            if (s != d) {
                i = strend - s;
@@ -1717,7 +1754,7 @@ PP(pp_subst)
        RETURN;
     }
 
-    if (regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+    if (CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
        if (force_on_match) {
            force_on_match = 0;
            s = SvPV_force(TARG, len);
@@ -1751,7 +1788,7 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (regexec_flags(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
+       } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
        sv_catpvn(dstr, s, strend - s);
 
        (void)SvOOK_off(TARG);
@@ -2440,7 +2477,9 @@ PP(pp_method)
            !(ob=(SV*)GvIO(iogv)))
        {
            if (!packname || !isIDFIRST(*packname))
-  DIE("Can't call method \"%s\" without a package or object reference", name);
+               DIE("Can't call method \"%s\" %s", name,
+                   SvOK(sv)? "without a package or object reference"
+                           : "on an undefined value");
            stash = gv_stashpvn(packname, packlen, TRUE);
            goto fetch;
        }