tweak for change#7173

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

diff --git a/op.c b/op.c
index 1203802..84a1df9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -495,7 +495,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
                   (sv = names[PL_padix]) && sv != &PL_sv_undef)
                continue;
            sv = *av_fetch(PL_comppad, PL_padix, TRUE);
-           if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) && !IS_PADGV(sv))
+           if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) &&
+               !IS_PADGV(sv) && !IS_PADCONST(sv))
                break;
        }
        retval = PL_padix;
@@ -2655,7 +2656,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            qsort(cp, i, sizeof(U8*), utf8compare);
            for (j = 0; j < i; j++) {
                U8 *s = cp[j];
-               UV val = utf8_to_uv(s, &ulen);
+               UV val = utf8_to_uv_chk(s, &ulen, 0);
                s += ulen;
                diff = val - nextmin;
                if (diff > 0) {
@@ -2668,7 +2669,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                    }
                }
                if (*s == 0xff)
-                   val = utf8_to_uv(s+1, &ulen);
+                   val = utf8_to_uv_chk(s+1, &ulen, 0);
                if (val >= nextmin)
                    nextmin = val + 1;
            }
@@ -2695,10 +2696,10 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        while (t < tend || tfirst <= tlast) {
            /* see if we need more "t" chars */
            if (tfirst > tlast) {
-               tfirst = (I32)utf8_to_uv(t, &ulen);
+               tfirst = (I32)utf8_to_uv_chk(t, &ulen, 0);
                t += ulen;
                if (t < tend && *t == 0xff) {   /* illegal utf8 val indicates range */
-                   tlast = (I32)utf8_to_uv(++t, &ulen);
+                   tlast = (I32)utf8_to_uv_chk(++t, &ulen, 0);
                    t += ulen;
                }
                else
@@ -2708,10 +2709,10 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            /* now see if we need more "r" chars */
            if (rfirst > rlast) {
                if (r < rend) {
-                   rfirst = (I32)utf8_to_uv(r, &ulen);
+                   rfirst = (I32)utf8_to_uv_chk(r, &ulen, 0);
                    r += ulen;
                    if (r < rend && *r == 0xff) {       /* illegal utf8 val indicates range */
-                       rlast = (I32)utf8_to_uv(++r, &ulen);
+                       rlast = (I32)utf8_to_uv_chk(++r, &ulen, 0);
                        r += ulen;
                    }
                    else
@@ -3415,7 +3416,11 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                    }
                    else if (curop->op_type == OP_PUSHRE) {
                        if (((PMOP*)curop)->op_pmreplroot) {
+#ifdef USE_ITHREADS
+                           GV *gv = (GV*)PL_curpad[(PADOFFSET)((PMOP*)curop)->op_pmreplroot];
+#else
                            GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
+#endif
                            if (gv == PL_defgv || SvCUR(gv) == PL_generation)
                                break;
                            SvCUR(gv) = PL_generation;
@@ -6458,6 +6463,22 @@ Perl_ck_trunc(pTHX_ OP *o)
     return ck_fun(o);
 }
 
+OP *
+Perl_ck_substr(pTHX_ OP *o)
+{
+    o = ck_fun(o);
+    if ((o->op_flags & OPf_KIDS) && o->op_private == 4) {
+       OP *kid = cLISTOPo->op_first;
+
+       if (kid->op_type == OP_NULL)
+           kid = kid->op_sibling;
+       if (kid)
+           kid->op_flags |= OPf_MOD;
+
+    }
+    return o;
+}
+
 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
 
 void
@@ -6673,7 +6694,7 @@ Perl_peep(pTHX_ register OP *o)
 
            /* Make the CONST have a shared SV */
            svp = cSVOPx_svp(((BINOP*)o)->op_last);
-           if (!SvFAKE(sv = *svp) || !SvREADONLY(sv)) {
+           if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
                key = SvPV(sv, keylen);
                lexname = newSVpvn_share(key, keylen, 0);
                SvREFCNT_dec(sv);