This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #7911] no warning for useless /d in tr/0-9//d
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 60c1b77..10c1fc9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,7 +1,7 @@
 /*    op.c
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,11 +9,13 @@
  */
 
 /*
- * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
- * our Mr. Bilbo's first cousin on the mother's side (her mother being the
- * youngest of the Old Took's daughters); and Mr. Drogo was his second
- * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
- * either way, as the saying is, if you follow me."  --the Gaffer
+ * 'You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
+ *  our Mr. Bilbo's first cousin on the mother's side (her mother being the
+ *  youngest of the Old Took's daughters); and Mr. Drogo was his second
+ *  cousin.  So Mr. Frodo is his first *and* second cousin, once removed
+ *  either way, as the saying is, if you follow me.'       --the Gaffer
+ *
+ *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
  */
 
 /* This file contains the functions that create, manipulate and optimize
@@ -635,7 +637,7 @@ Perl_op_clear(pTHX_ OP *o)
            pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
        }
 #else
-       SvREFCNT_dec((SV*)cPMOPo->op_pmreplrootu.op_pmtargetgv);
+       SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv));
 #endif
        /* FALL THROUGH */
     case OP_MATCH:
@@ -695,7 +697,7 @@ S_forget_pmop(pTHX_ PMOP *const o
     PERL_ARGS_ASSERT_FORGET_PMOP;
 
     if (pmstash && !SvIS_FREED(pmstash)) {
-       MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
+       MAGIC * const mg = mg_find((const SV *)pmstash, PERL_MAGIC_symtab);
        if (mg) {
            PMOP **const array = (PMOP**) mg->mg_ptr;
            U32 count = mg->mg_len / sizeof(PMOP**);
@@ -1138,6 +1140,20 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     case OP_OR:
     case OP_AND:
+       kid = cLOGOPo->op_first;
+       if (kid->op_type == OP_NOT
+           && (kid->op_flags & OPf_KIDS)
+           && !PL_madskills) {
+           if (o->op_type == OP_AND) {
+               o->op_type = OP_OR;
+               o->op_ppaddr = PL_ppaddr[OP_OR];
+           } else {
+               o->op_type = OP_AND;
+               o->op_ppaddr = PL_ppaddr[OP_AND];
+           }
+           op_null(kid);
+       }
+
     case OP_DOR:
     case OP_COND_EXPR:
     case OP_ENTERGIVEN:
@@ -2015,7 +2031,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
                                  newSVOP(OP_CONST, 0, newSVpv(stashpv,0)),
                                  prepend_elem(OP_LIST,
                                               newSVOP(OP_CONST, 0,
-                                                      newRV((SV*)cv)),
+                                                      newRV(MUTABLE_SV(cv))),
                                                attrs)));
 }
 
@@ -2061,8 +2077,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
            PL_parser->in_my_stash = NULL;
            apply_attrs(GvSTASH(gv),
                        (type == OP_RV2SV ? GvSV(gv) :
-                        type == OP_RV2AV ? (SV*)GvAV(gv) :
-                        type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv),
+                        type == OP_RV2AV ? MUTABLE_SV(GvAV(gv)) :
+                        type == OP_RV2HV ? MUTABLE_SV(GvHV(gv)) : MUTABLE_SV(gv)),
                        attrs, FALSE);
        }
        o->op_private |= OPpOUR_INTRO;
@@ -2335,9 +2351,9 @@ Perl_newPROG(pTHX_ OP *o)
            if (cv) {
                dSP;
                PUSHMARK(SP);
-               XPUSHs((SV*)CopFILEGV(&PL_compiling));
+               XPUSHs(MUTABLE_SV(CopFILEGV(&PL_compiling)));
                PUTBACK;
-               call_sv((SV*)cv, G_DISCARD);
+               call_sv(MUTABLE_SV(cv), G_DISCARD);
            }
        }
     }
@@ -2521,7 +2537,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     case 3:
        /* Something tried to die.  Abandon constant folding.  */
        /* Pretend the error never happened.  */
-       sv_setpvn(ERRSV,"",0);
+       CLEAR_ERRSV();
        o->op_next = old_next;
        break;
     default:
@@ -2549,9 +2565,9 @@ Perl_fold_constants(pTHX_ register OP *o)
 #endif
     assert(sv);
     if (type == OP_RV2GV)
-       newop = newGVOP(OP_GV, 0, (GV*)sv);
+       newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
-       newop = newSVOP(OP_CONST, 0, (SV*)sv);
+       newop = newSVOP(OP_CONST, 0, MUTABLE_SV(sv));
     op_getmad(o,newop,'f');
     return newop;
 
@@ -2765,7 +2781,7 @@ Perl_token_getmad(pTHX_ TOKEN* tk, OP* o, char slot)
     /* faked up qw list? */
     if (slot == '(' &&
        tm->mad_type == MAD_SV &&
-       SvPVX((SV*)tm->mad_val)[0] == 'q')
+       SvPVX((const SV *)tm->mad_val)[0] == 'q')
            slot = 'x';
 
     if (o) {
@@ -2956,7 +2972,7 @@ Perl_mad_free(pTHX_ MADPROP* mp)
            op_free((OP*)mp->mad_val);
        break;
     case MAD_SV:
-       sv_free((SV*)mp->mad_val);
+       sv_free(MUTABLE_SV(mp->mad_val));
        break;
     default:
        PerlIO_printf(PerlIO_stderr(), "Unrecognized mad\n");
@@ -3334,7 +3350,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        PerlMemShared_free(cPVOPo->op_pv);
        cPVOPo->op_pv = NULL;
 
-       swash = (SV*)swash_init("utf8", "", listsv, bits, none);
+       swash = MUTABLE_SV(swash_init("utf8", "", listsv, bits, none));
 #ifdef USE_ITHREADS
        cPADOPo->op_padix = pad_alloc(OP_TRANS, SVs_PADTMP);
        SvREFCNT_dec(PAD_SVl(cPADOPo->op_padix));
@@ -3347,7 +3363,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        SvREFCNT_dec(transv);
 
        if (!del && havefinal && rlen)
-           (void)hv_store((HV*)SvRV(swash), "FINAL", 5,
+           (void)hv_store(MUTABLE_HV(SvRV(swash)), "FINAL", 5,
                           newSVuv((UV)final), 0);
 
        if (grows)
@@ -3435,6 +3451,15 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            }
        }
     }
+
+    if(ckWARN(WARN_MISC)) {
+        if(del && rlen == tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
+        } else if(rlen > tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
+        } 
+    }
+
     if (grows)
        o->op_private |= OPpTRANS_GROWS;
 #ifdef PERL_MAD
@@ -4250,7 +4275,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                    else if (curop->op_type == OP_PUSHRE) {
 #ifdef USE_ITHREADS
                        if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
-                           GV *const gv = (GV*)PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff);
+                           GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff));
                            if (gv == PL_defgv
                                || (int)GvASSIGN_GENERATION(gv) == PL_generation)
                                break;
@@ -4298,7 +4323,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                        cPADOPx(tmpop)->op_padix = 0;   /* steal it */
 #else
                        pm->op_pmreplrootu.op_pmtargetgv
-                           = (GV*)cSVOPx(tmpop)->op_sv;
+                           = MUTABLE_GV(cSVOPx(tmpop)->op_sv);
                        cSVOPx(tmpop)->op_sv = NULL;    /* steal it */
 #endif
                        pm->op_pmflags |= PMf_ONCE;
@@ -4408,7 +4433,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 #endif
     CopSTASH_set(cop, PL_curstash);
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash) {
+    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash) {
+       /* this line can have a breakpoint - store the cop in IV */
        AV *av = CopFILEAVx(PL_curcop);
        if (av) {
            SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
@@ -4436,46 +4462,95 @@ Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
 }
 
 STATIC OP *
+S_search_const(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_SEARCH_CONST;
+
+    switch (o->op_type) {
+       case OP_CONST:
+           return o;
+       case OP_NULL:
+           if (o->op_flags & OPf_KIDS)
+               return search_const(cUNOPo->op_first);
+           break;
+       case OP_LEAVE:
+       case OP_SCOPE:
+       case OP_LINESEQ:
+       {
+           OP *kid;
+           if (!(o->op_flags & OPf_KIDS))
+               return NULL;
+           kid = cLISTOPo->op_first;
+           do {
+               switch (kid->op_type) {
+                   case OP_ENTER:
+                   case OP_NULL:
+                   case OP_NEXTSTATE:
+                       kid = kid->op_sibling;
+                       break;
+                   default:
+                       if (kid != cLISTOPo->op_last)
+                           return NULL;
+                       goto last;
+               }
+           } while (kid);
+           if (!kid)
+               kid = cLISTOPo->op_last;
+last:
+           return search_const(kid);
+       }
+    }
+
+    return NULL;
+}
+
+STATIC OP *
 S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dVAR;
     LOGOP *logop;
     OP *o;
-    OP *first = *firstp;
-    OP * const other = *otherp;
+    OP *first;
+    OP *other;
+    OP *cstop = NULL;
+    int prepend_not = 0;
 
     PERL_ARGS_ASSERT_NEW_LOGOP;
 
+    first = *firstp;
+    other = *otherp;
+
     if (type == OP_XOR)                /* Not short circuit, but here by precedence. */
        return newBINOP(type, flags, scalar(first), scalar(other));
 
     scalarboolean(first);
-    /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
+    /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
-       && (first->op_flags & OPf_SPECIAL)
        && (first->op_flags & OPf_KIDS)
+       && ((first->op_flags & OPf_SPECIAL) /* unless ($x) { } */
+           || (other->op_type == OP_NOT))  /* if (!$x && !$y) { } */
        && !PL_madskills) {
        if (type == OP_AND || type == OP_OR) {
            if (type == OP_AND)
                type = OP_OR;
            else
                type = OP_AND;
-           o = first;
-           first = *firstp = cUNOPo->op_first;
-           if (o->op_next)
-               first->op_next = o->op_next;
-           cUNOPo->op_first = NULL;
-           op_free(o);
+           op_null(first);
+           if (other->op_type == OP_NOT) { /* !a AND|OR !b => !(a OR|AND b) */
+               op_null(other);
+               prepend_not = 1; /* prepend a NOT op later */
+           }
        }
     }
-    if (first->op_type == OP_CONST) {
-       if (first->op_private & OPpCONST_STRICT)
-           no_bareword_allowed(first);
-       else if ((first->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
+    /* search for a constant op that could let us fold the test */
+    if ((cstop = search_const(first))) {
+       if (cstop->op_private & OPpCONST_STRICT)
+           no_bareword_allowed(cstop);
+       else if ((cstop->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
                Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
-       if ((type == OP_AND &&  SvTRUE(((SVOP*)first)->op_sv)) ||
-           (type == OP_OR  && !SvTRUE(((SVOP*)first)->op_sv)) ||
-           (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) {
+       if ((type == OP_AND &&  SvTRUE(((SVOP*)cstop)->op_sv)) ||
+           (type == OP_OR  && !SvTRUE(((SVOP*)cstop)->op_sv)) ||
+           (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) {
            *firstp = NULL;
            if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_SHORTCIRCUIT;
@@ -4582,7 +4657,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     CHECKOP(type,logop);
 
-    o = newUNOP(OP_NULL, 0, (OP*)logop);
+    o = newUNOP(prepend_not ? OP_NOT : OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
     return o;
@@ -4595,6 +4670,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     LOGOP *logop;
     OP *start;
     OP *o;
+    OP *cstop;
 
     PERL_ARGS_ASSERT_NEWCONDOP;
 
@@ -4604,14 +4680,14 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        return newLOGOP(OP_OR, 0, first, falseop);
 
     scalarboolean(first);
-    if (first->op_type == OP_CONST) {
+    if ((cstop = search_const(first))) {
        /* Left or right arm of the conditional?  */
-       const bool left = SvTRUE(((SVOP*)first)->op_sv);
+       const bool left = SvTRUE(((SVOP*)cstop)->op_sv);
        OP *live = left ? trueop : falseop;
        OP *const dead = left ? falseop : trueop;
-        if (first->op_private & OPpCONST_BARE &&
-           first->op_private & OPpCONST_STRICT) {
-           no_bareword_allowed(first);
+        if (cstop->op_private & OPpCONST_BARE &&
+           cstop->op_private & OPpCONST_STRICT) {
+           no_bareword_allowed(cstop);
        }
        if (PL_madskills) {
            /* This is all dead code when PERL_MAD is not defined.  */
@@ -5249,7 +5325,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        CvSTART(cv) = NULL;
        LEAVE;
     }
-    SvPOK_off((SV*)cv);                /* forget prototype */
+    SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     CvGV(cv) = NULL;
 
     pad_undef(cv);
@@ -5261,7 +5337,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        CvOUTSIDE(cv) = NULL;
     }
     if (CvCONST(cv)) {
-       SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
+       SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
        CvCONST_off(cv);
     }
     if (CvISXSUB(cv) && CvXSUB(cv)) {
@@ -5321,14 +5397,14 @@ L<perlsub/"Constant Functions">.
 =cut
 */
 SV *
-Perl_cv_const_sv(pTHX_ CV *cv)
+Perl_cv_const_sv(pTHX_ const CV *const cv)
 {
     PERL_UNUSED_CONTEXT;
     if (!cv)
        return NULL;
     if (!(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM))
        return NULL;
-    return CvCONST(cv) ? (SV*)CvXSUBANY(cv).any_ptr : NULL;
+    return CvCONST(cv) ? MUTABLE_SV(CvXSUBANY(cv).any_ptr) : NULL;
 }
 
 /* op_const_sv:  examine an optree to determine whether it's in-lineable.
@@ -5500,17 +5576,18 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (SvTYPE(gv) != SVt_PVGV) {      /* Maybe prototype now, and had at
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
-           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
+           if (!SvPOK((const SV *)gv)
+               && !(SvIOK((const SV *)gv) && SvIVX((const SV *)gv) == -1)
                && ckWARN_d(WARN_PROTOTYPE))
            {
                Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype");
            }
-           cv_ckproto_len((CV*)gv, NULL, ps, ps_len);
+           cv_ckproto_len((const CV *)gv, NULL, ps, ps_len);
        }
        if (ps)
-           sv_setpvn((SV*)gv, ps, ps_len);
+           sv_setpvn(MUTABLE_SV(gv), ps, ps_len);
        else
-           sv_setiv((SV*)gv, -1);
+           sv_setiv(MUTABLE_SV(gv), -1);
 
        SvREFCNT_dec(PL_compcv);
        cv = PL_compcv = NULL;
@@ -5597,7 +5674,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
-           sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
+           sv_setpvs(MUTABLE_SV(cv), "");  /* prototype is "" */
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
            CvCONST_on(cv);
@@ -5633,7 +5710,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    || block->op_type == OP_NULL
 #endif
                    )) {
-           rcv = (SV*)cv;
+           rcv = MUTABLE_SV(cv);
            /* Might have had built-in attributes applied -- propagate them. */
            CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
            if (CvGV(cv) && GvSTASH(CvGV(cv)))
@@ -5645,7 +5722,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
        else {
            /* possibly about to re-define existing subr -- ignore old cv */
-           rcv = (SV*)PL_compcv;
+           rcv = MUTABLE_SV(PL_compcv);
            if (name && GvSTASH(gv))
                stash = GvSTASH(gv);
            else
@@ -5691,7 +5768,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            GvCV(gv) = cv;
            if (PL_madskills) {
                if (strEQ(name, "import")) {
-                   PL_formfeed = (SV*)cv;
+                   PL_formfeed = MUTABLE_SV(cv);
                    Perl_warner(aTHX_ packWARN(WARN_VOID), "%lx\n", (long)cv);
                }
            }
@@ -5704,7 +5781,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     CvSTASH(cv) = PL_curstash;
 
     if (ps)
-       sv_setpvn((SV*)cv, ps, ps_len);
+       sv_setpvn(MUTABLE_SV(cv), ps, ps_len);
 
     if (PL_parser && PL_parser->error_count) {
        op_free(block);
@@ -5729,6 +5806,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (!block)
        goto done;
 
+    /* If we assign an optree to a PVCV, then we've defined a subroutine that
+       the debugger could be able to set a breakpoint in, so signal to
+       pp_entereval that it should not throw away any saved lines at scope
+       exit.  */
+       
+    PL_breakable_sub_gen++;
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));
@@ -5787,7 +5870,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    PUSHMARK(SP);
                    XPUSHs(tmpstr);
                    PUTBACK;
-                   call_sv((SV*)pcv, G_DISCARD);
+                   call_sv(MUTABLE_SV(pcv), G_DISCARD);
                }
            }
        }
@@ -5820,7 +5903,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
            SAVECOPLINE(&PL_compiling);
 
            DEBUG_x( dump_sub(gv) );
-           Perl_av_create_and_push(aTHX_ &PL_beginav, (SV*)cv);
+           Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
            GvCV(gv) = 0;               /* cv has been hijacked */
            call_list(oldscope, PL_beginav);
 
@@ -5834,13 +5917,13 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
        if (*name == 'E') {
            if strEQ(name, "END") {
                DEBUG_x( dump_sub(gv) );
-               Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
+               Perl_av_create_and_unshift_one(aTHX_ &PL_endav, MUTABLE_SV(cv));
            } else
                return;
        } else if (*name == 'U') {
            if (strEQ(name, "UNITCHECK")) {
                /* It's never too late to run a unitcheck block */
-               Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, (SV*)cv);
+               Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, MUTABLE_SV(cv));
            }
            else
                return;
@@ -5849,7 +5932,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
                if (PL_main_start && ckWARN(WARN_VOID))
                    Perl_warner(aTHX_ packWARN(WARN_VOID),
                                "Too late to run CHECK block");
-               Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
+               Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, MUTABLE_SV(cv));
            }
            else
                return;
@@ -5858,7 +5941,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
                if (PL_main_start && ckWARN(WARN_VOID))
                    Perl_warner(aTHX_ packWARN(WARN_VOID),
                                "Too late to run INIT block");
-               Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv));
            }
            else
                return;
@@ -5964,7 +6047,7 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
        }
 
        /* This gets free()d.  :-)  */
-       sv_usepvn_flags((SV*)cv, proto_and_file, proto_and_file_len,
+       sv_usepvn_flags(MUTABLE_SV(cv), proto_and_file, proto_and_file_len,
                        SV_HAS_TRAILING_NUL);
        if (proto) {
            /* This gives us the correct prototype, rather than one with the
@@ -5975,7 +6058,7 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
        }
        CvFILE(cv) = proto_and_file + proto_len;
     } else {
-       sv_setpv((SV *)cv, proto);
+       sv_setpv(MUTABLE_SV(cv), proto);
     }
     return cv;
 }
@@ -6039,7 +6122,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
     if (cv)                            /* must reuse cv if autoloaded */
        cv_undef(cv);
     else {
-       cv = (CV*)newSV_type(SVt_PVCV);
+       cv = MUTABLE_CV(newSV_type(SVt_PVCV));
        if (name) {
            GvCV(gv) = cv;
            GvCVGEN(gv) = 0;
@@ -6146,7 +6229,7 @@ Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block)
 {
     return newUNOP(OP_REFGEN, 0,
        newSVOP(OP_ANONCODE, 0,
-               (SV*)newATTRSUB(floor, 0, proto, attrs, block)));
+               MUTABLE_SV(newATTRSUB(floor, 0, proto, attrs, block))));
 }
 
 OP *
@@ -6494,7 +6577,7 @@ Perl_ck_eval(pTHX_ OP *o)
     if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
        /* Store a copy of %^H that pp_entereval can pick up. */
        OP *hhop = newSVOP(OP_HINTSEVAL, 0,
-                          (SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
+                          MUTABLE_SV(Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv))));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;
     }
@@ -6556,7 +6639,7 @@ Perl_ck_exists(pTHX_ OP *o)
        else if (kid->op_type == OP_AELEM)
            o->op_flags |= OPf_SPECIAL;
        else if (kid->op_type != OP_HELEM)
-           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or a subroutine",
                        OP_DESC(o));
        op_null(kid);
     }
@@ -6670,7 +6753,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
            kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
            SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
            GvIN_PAD_on(gv);
-           PAD_SETSV(kPADOP->op_padix, (SV*) SvREFCNT_inc_simple_NN(gv));
+           PAD_SETSV(kPADOP->op_padix, MUTABLE_SV(SvREFCNT_inc_simple_NN(gv)));
 #else
            kid->op_sv = SvREFCNT_inc_simple_NN(gv);
 #endif
@@ -6950,7 +7033,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                namesv = PAD_SVl(targ);
                                SvUPGRADE(namesv, SVt_PV);
                                if (*name != '$')
-                                   sv_setpvn(namesv, "$", 1);
+                                   sv_setpvs(namesv, "$");
                                sv_catpvn(namesv, name, len);
                            }
                        }
@@ -7033,7 +7116,7 @@ Perl_ck_glob(pTHX_ OP *o)
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
        glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV);
        GvCV(gv) = GvCV(glob_gv);
-       SvREFCNT_inc_void((SV*)GvCV(gv));
+       SvREFCNT_inc_void(MUTABLE_SV(GvCV(gv)));
        GvIMPORTED_CV_on(gv);
        LEAVE;
     }
@@ -7415,7 +7498,9 @@ Perl_ck_open(pTHX_ OP *o)
     if (table) {
        SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_IN_RAW;
            else if (mode & O_TEXT)
@@ -7424,7 +7509,9 @@ Perl_ck_open(pTHX_ OP *o)
 
        svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_OUT_RAW;
            else if (mode & O_TEXT)
@@ -7847,7 +7934,7 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
        if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-           const char *pmstr = re ? RX_PRECOMP(re) : "STRING";
+           const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING";
            const STRLEN len = re ? RX_PRELEN(re) : 6;
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "/%.*s/ should probably be written as \"%.*s\"",
@@ -7893,7 +7980,7 @@ Perl_ck_subr(pTHX_ OP *o)
                if (SvPOK(cv)) {
                    STRLEN len;
                    namegv = CvANON(cv) ? gv : CvGV(cv);
-                   proto = SvPV((SV*)cv, len);
+                   proto = SvPV(MUTABLE_SV(cv), len);
                    proto_end = proto + len;
                }
            }
@@ -8015,7 +8102,7 @@ Perl_ck_subr(pTHX_ OP *o)
                         const char *p = proto;
                         const char *const end = proto;
                         contextclass = 0;
-                        while (*--p != '[');
+                        while (*--p != '[') {}
                         bad_type(arg, Perl_form(aTHX_ "one of %.*s",
                                                 (int)(end - p), p),
                                  gv_ename(namegv), o3);
@@ -8884,7 +8971,7 @@ const_sv_xsub(pTHX_ CV* cv)
 #endif
     }
     EXTEND(sp, 1);
-    ST(0) = (SV*)XSANY.any_ptr;
+    ST(0) = MUTABLE_SV(XSANY.any_ptr);
     XSRETURN(1);
 }