[perl #96230] Stop s/$qr// from reusing last pattern

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index a14b62b..28a774e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -152,6 +152,40 @@ PP(pp_padcv)
     RETURN;
 }
 
+PP(pp_introcv)
+{
+    dVAR; dTARGET;
+    SvPADSTALE_off(TARG);
+    return NORMAL;
+}
+
+PP(pp_clonecv)
+{
+    dVAR; dTARGET;
+    MAGIC * const mg =
+       mg_find(PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG],
+               PERL_MAGIC_proto);
+    assert(SvTYPE(TARG) == SVt_PVCV);
+    assert(mg);
+    assert(mg->mg_obj);
+    if (CvISXSUB(mg->mg_obj)) { /* constant */
+       /* XXX Should we clone it here? */
+       /* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV
+          to introcv and remove the SvPADSTALE_off. */
+       SAVEPADSVANDMORTALIZE(ARGTARG);
+       PAD_SVl(ARGTARG) = mg->mg_obj;
+    }
+    else {
+       if (CvROOT(mg->mg_obj)) {
+           assert(CvCLONE(mg->mg_obj));
+           assert(!CvCLONED(mg->mg_obj));
+       }
+       cv_clone_into((CV *)mg->mg_obj,(CV *)TARG);
+       SAVECLEARSV(PAD_SVl(ARGTARG));
+    }
+    return NORMAL;
+}
+
 /* Translations. */
 
 static const char S_no_symref_sv[] =
@@ -946,11 +980,9 @@ PP(pp_undef)
        }
        break;
     case SVt_PVGV:
-       if (SvFAKE(sv)) {
-           SvSetMagicSV(sv, &PL_sv_undef);
-           break;
-       }
-       else if (isGV_with_GP(sv)) {
+       assert(isGV_with_GP(sv));
+       assert(!SvFAKE(sv));
+       {
            GP *gp;
             HV *stash;
 
@@ -988,7 +1020,6 @@ PP(pp_undef)
 
            break;
        }
-       /* FALL THROUGH */
     default:
        if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
            SvPV_free(sv);
@@ -2882,7 +2913,7 @@ PP(pp_length)
            SETi(len);
     } else if (SvOK(sv)) {
        /* Neither magic nor overloaded.  */
-       if (DO_UTF8(sv))
+       if (!IN_BYTES)
            SETi(sv_len_utf8(sv));
        else
            SETi(sv_len(sv));
@@ -2983,7 +3014,6 @@ PP(pp_substr)
     STRLEN repl_len;
     int num_args = PL_op->op_private & 7;
     bool repl_need_utf8_upgrade = FALSE;
-    bool repl_is_utf8 = FALSE;
 
     if (num_args > 2) {
        if (num_args > 3) {
@@ -3004,17 +3034,7 @@ PP(pp_substr)
        repl_sv = POPs;
     }
     PUTBACK;
-    if (repl_sv) {
-       repl = SvPV_const(repl_sv, repl_len);
-       repl_is_utf8 = DO_UTF8(repl_sv) && repl_len;
-       if (repl_is_utf8) {
-           if (!DO_UTF8(sv))
-               sv_utf8_upgrade(sv);
-       }
-       else if (DO_UTF8(sv))
-           repl_need_utf8_upgrade = TRUE;
-    }
-    else if (lvalue) {
+    if (lvalue && !repl_sv) {
        SV * ret;
        ret = sv_2mortal(newSV_type(SVt_PVLV));  /* Not TARG RT#67838 */
        sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
@@ -3033,9 +3053,26 @@ PP(pp_substr)
        PUSHs(ret);    /* avoid SvSETMAGIC here */
        RETURN;
     }
-    tmps = SvPV_const(sv, curlen);
+    if (repl_sv) {
+       repl = SvPV_const(repl_sv, repl_len);
+       SvGETMAGIC(sv);
+       if (SvROK(sv))
+           Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+                           "Attempt to use reference as lvalue in substr"
+           );
+       tmps = SvPV_force_nomg(sv, curlen);
+       if (DO_UTF8(repl_sv) && repl_len) {
+           if (!DO_UTF8(sv)) {
+               sv_utf8_upgrade_nomg(sv);
+               curlen = SvCUR(sv);
+           }
+       }
+       else if (DO_UTF8(sv))
+           repl_need_utf8_upgrade = TRUE;
+    }
+    else tmps = SvPV_const(sv, curlen);
     if (DO_UTF8(sv)) {
-        utf8_curlen = sv_len_utf8_nomg(sv);
+        utf8_curlen = sv_or_pv_len_utf8(sv, tmps, curlen);
        if (utf8_curlen == curlen)
            utf8_curlen = 0;
        else
@@ -3053,7 +3090,7 @@ PP(pp_substr)
 
        byte_len = len;
        byte_pos = utf8_curlen
-           ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
+           ? sv_or_pv_pos_u2b(sv, tmps, pos, &byte_len) : pos;
 
        tmps += byte_pos;
 
@@ -3075,17 +3112,10 @@ PP(pp_substr)
                repl_sv_copy = newSVsv(repl_sv);
                sv_utf8_upgrade(repl_sv_copy);
                repl = SvPV_const(repl_sv_copy, repl_len);
-               repl_is_utf8 = DO_UTF8(repl_sv_copy) && repl_len;
            }
-           if (SvROK(sv))
-               Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
-                           "Attempt to use reference as lvalue in substr"
-               );
            if (!SvOK(sv))
                sv_setpvs(sv, "");
            sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
-           if (repl_is_utf8)
-               SvUTF8_on(sv);
            SvREFCNT_dec(repl_sv_copy);
        }
     }
@@ -5265,6 +5295,7 @@ PP(pp_split)
     STRLEN len;
     const char *s = SvPV_const(sv, len);
     const bool do_utf8 = DO_UTF8(sv);
+    const bool skipwhite = PL_op->op_flags & OPf_SPECIAL;
     const char *strend = s + len;
     PMOP *pm;
     REGEXP *rx;
@@ -5295,7 +5326,7 @@ PP(pp_split)
     rx = PM_GETRE(pm);
 
     TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
-            (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
+            (RX_EXTFLAGS(rx) & RXf_WHITE || skipwhite));
 
     RX_MATCH_UTF8_set(rx, do_utf8);
 
@@ -5335,7 +5366,7 @@ PP(pp_split)
     }
     base = SP - PL_stack_base;
     orig = s;
-    if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
+    if (skipwhite) {
        if (do_utf8) {
            while (*s == ' ' || is_utf8_space((U8*)s))
                s += UTF8SKIP(s);
@@ -5357,7 +5388,7 @@ PP(pp_split)
 
     if (!limit)
        limit = maxiters + 2;
-    if (RX_EXTFLAGS(rx) & RXf_WHITE) {
+    if (RX_EXTFLAGS(rx) & RXf_WHITE || skipwhite) {
        while (--limit) {
            m = s;
            /* this one uses 'm' and is a negative test */