more embed cleanup
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 73f33ff..c541fd1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -128,8 +128,8 @@ Perl_Slab_Alloc(pTHX_ int m, size_t sz)
 void
 Perl_Slab_Free(pTHX_ void *op)
 {
-    I32 **ptr = (I32 **) op;
-    I32 *slab = ptr[-1];
+    I32 ** const ptr = (I32 **) op;
+    I32 * const slab = ptr[-1];
     assert( ptr-1 > (I32 **) slab );
     assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
     assert( *slab > 0 );
@@ -158,13 +158,12 @@ Perl_Slab_Free(pTHX_ void *op)
 
 #define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
 
-STATIC char*
+STATIC const char*
 S_gv_ename(pTHX_ GV *gv)
 {
-    STRLEN n_a;
-    SV* tmpsv = sv_newmortal();
+    SV* const tmpsv = sv_newmortal();
     gv_efullname3(tmpsv, gv, Nullch);
-    return SvPV(tmpsv,n_a);
+    return SvPV_nolen_const(tmpsv);
 }
 
 STATIC OP *
@@ -1596,14 +1595,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
                                    dup_attrlist(attrs)));
 
     /* Fake up a method call to import */
-    meth = newSVpvn("import", 6);
-    SvUPGRADE(meth, SVt_PVIV);
-    (void)SvIOK_on(meth);
-    {
-       U32 hash;
-       PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
-       SvUV_set(meth, hash);
-    }
+    meth = newSVpvn_share("import", 6, 0);
     imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
                   append_elem(OP_LIST,
                               prepend_elem(OP_LIST, pack, list(arg)),
@@ -1644,7 +1636,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
     while (len) {
         for (; isSPACE(*attrstr) && len; --len, ++attrstr) ;
         if (len) {
-            const char *sstr = attrstr;
+            const char * const sstr = attrstr;
             for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ;
             attrs = append_elem(OP_LIST, attrs,
                                 newSVOP(OP_CONST, 0,
@@ -1775,11 +1767,12 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     OP *o;
     bool ismatchop = 0;
 
-    if (ckWARN(WARN_MISC) &&
-      (left->op_type == OP_RV2AV ||
+    if ( (left->op_type == OP_RV2AV ||
        left->op_type == OP_RV2HV ||
        left->op_type == OP_PADAV ||
-       left->op_type == OP_PADHV)) {
+       left->op_type == OP_PADHV)
+       && ckWARN(WARN_MISC))
+    {
       const char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
                             right->op_type == OP_TRANS)
                            ? right->op_type : OP_MATCH];
@@ -1968,8 +1961,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
        ;
 #endif
     else {
-       if (ckWARN(WARN_PARENTHESIS)
-           && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
+       if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
+           && ckWARN(WARN_PARENTHESIS))
        {
            char *s = PL_bufptr;
            bool sigil = FALSE;
@@ -2384,8 +2377,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     SV *rstr = ((SVOP*)repl)->op_sv;
     STRLEN tlen;
     STRLEN rlen;
-    U8 *t = (U8*)SvPV(tstr, tlen);
-    U8 *r = (U8*)SvPV(rstr, rlen);
+    const U8 *t = (U8*)SvPV_const(tstr, tlen);
+    const U8 *r = (U8*)SvPV_const(rstr, rlen);
     register I32 i;
     register I32 j;
     I32 del;
@@ -2408,8 +2401,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
        SV* listsv = newSVpvn("# comment\n",10);
        SV* transv = 0;
-       U8* tend = t + tlen;
-       U8* rend = r + rlen;
+       const U8* tend = t + tlen;
+       const U8* rend = r + rlen;
        STRLEN ulen;
        UV tfirst = 1;
        UV tlast = 0;
@@ -2430,12 +2423,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
        if (!from_utf) {
            STRLEN len = tlen;
-           tsave = t = bytes_to_utf8(t, &len);
+           t = tsave = bytes_to_utf8(t, &len);
            tend = t + len;
        }
        if (!to_utf && rlen) {
            STRLEN len = rlen;
-           rsave = r = bytes_to_utf8(r, &len);
+           r = rsave = bytes_to_utf8(r, &len);
            rend = r + len;
        }
 
@@ -2449,7 +2442,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            U8 tmpbuf[UTF8_MAXBYTES+1];
            UV *cp;
            UV nextmin = 0;
-           New(1109, cp, 2*tlen, UV);
+           Newx(cp, 2*tlen, UV);
            i = 0;
            transv = newSVpvn("",0);
            while (t < tend) {
@@ -2492,7 +2485,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            t = uvuni_to_utf8_flags(tmpbuf, 0x7fffffff,
                                    UNICODE_ALLOW_SUPER);
            sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
-           t = (U8*)SvPVX(transv);
+           t = (const U8*)SvPVX_const(transv);
            tlen = SvCUR(transv);
            tend = t + tlen;
            Safefree(cp);
@@ -2792,15 +2785,31 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
     if (expr->op_type == OP_CONST) {
        STRLEN plen;
        SV *pat = ((SVOP*)expr)->op_sv;
-       char *p = SvPV(pat, plen);
+       const char *p = SvPV_const(pat, plen);
        if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) {
+           U32 was_readonly = SvREADONLY(pat);
+
+           if (was_readonly) {
+               if (SvFAKE(pat)) {
+                   sv_force_normal_flags(pat, 0);
+                   assert(!SvREADONLY(pat));
+                   was_readonly = 0;
+               } else {
+                   SvREADONLY_off(pat);
+               }
+           }   
+
            sv_setpvn(pat, "\\s+", 3);
-           p = SvPV(pat, plen);
+
+           SvFLAGS(pat) |= was_readonly;
+
+           p = SvPV_const(pat, plen);
            pm->op_pmflags |= PMf_SKIPWHITE;
        }
         if (DO_UTF8(pat))
            pm->op_pmdynflags |= PMdf_UTF8;
-       PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
+       /* FIXME - can we make this function take const char * args?  */
+       PM_SETRE(pm, CALLREGCOMP(aTHX_ (char*)p, (char*)p + plen, pm));
        if (strEQ("\\s+", PM_GETRE(pm)->precomp))
            pm->op_pmflags |= PMf_WHITE;
        op_free(expr);
@@ -2996,7 +3005,7 @@ Perl_package(pTHX_ OP *o)
     save_hptr(&PL_curstash);
     save_item(PL_curstname);
 
-    name = SvPV(cSVOPo->op_sv, len);
+    name = SvPV_const(cSVOPo->op_sv, len);
     PL_curstash = gv_stashpvn(name, len, TRUE);
     sv_setpvn(PL_curstname, name, len);
     op_free(o);
@@ -3018,10 +3027,10 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 
     veop = Nullop;
 
-    if (version != Nullop) {
+    if (version) {
        SV *vesv = ((SVOP*)version)->op_sv;
 
-       if (arg == Nullop && !SvNIOKp(vesv)) {
+       if (!arg && !SvNIOKp(vesv)) {
            arg = version;
        }
        else {
@@ -3035,14 +3044,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
            /* Fake up a method call to VERSION */
-           meth = newSVpvn("VERSION",7);
-           sv_upgrade(meth, SVt_PVIV);
-           (void)SvIOK_on(meth);
-           {
-               U32 hash;
-               PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
-               SvUV_set(meth, hash);
-           }
+           meth = newSVpvn_share("VERSION", 7, 0);
            veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                            append_elem(OP_LIST,
                                        prepend_elem(OP_LIST, pack, list(version)),
@@ -3063,14 +3065,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
        pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
        /* Fake up a method call to import/unimport */
-       meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
-       SvUPGRADE(meth, SVt_PVIV);
-       (void)SvIOK_on(meth);
-       {
-           U32 hash;
-           PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
-           SvUV_set(meth, hash);
-       }
+       meth = aver
+           ? newSVpvn_share("import",6, 0) : newSVpvn_share("unimport", 8, 0);
        imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                       append_elem(OP_LIST,
                                   prepend_elem(OP_LIST, pack, list(arg)),
@@ -3079,7 +3075,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newATTRSUB(floor,
-       newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
+       newSVOP(OP_CONST, 0, newSVpvn_share("BEGIN", 5, 0)),
        Nullop,
        Nullop,
        append_elem(OP_LINESEQ,
@@ -3279,14 +3275,15 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        OP *curop;
 
        PL_modcount = 0;
-       PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
+       /* Grandfathering $[ assignment here.  Bletch.*/
+       /* Only simple assignments like C<< ($[) = 1 >> are allowed */
+       PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
        left = mod(left, OP_AASSIGN);
        if (PL_eval_start)
            PL_eval_start = 0;
-       else {
-           op_free(left);
-           op_free(right);
-           return Nullop;
+       else if (left->op_type == OP_CONST) {
+           /* Result of assignment is always 1 (or we'd be dead already) */
+           return newSVOP(OP_CONST, 0, newSViv(1));
        }
        /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
        if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
@@ -3423,8 +3420,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        if (PL_eval_start)
            PL_eval_start = 0;
        else {
-           op_free(o);
-           return Nullop;
+           o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
        }
     }
     return o;
@@ -3533,7 +3529,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     if (first->op_type == OP_CONST) {
        if (first->op_private & OPpCONST_STRICT)
            no_bareword_allowed(first);
-       else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
+       else if ((first->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)) ||
@@ -3569,8 +3565,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            return first;
        }
     }
-    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
-             type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
+    else if ((first->op_flags & OPf_KIDS) && type != OP_DOR
+       && ckWARN(WARN_MISC)) /* [#24076] Don't warn for <FH> err FOO. */
     {
        const OP *k1 = ((UNOP*)first)->op_first;
        const OP *k2 = k1->op_sibling;
@@ -3747,7 +3743,8 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
     OP* o;
     const bool once = block && block->op_flags & OPf_SPECIAL &&
       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
-    (void)debuggable;
+
+    PERL_UNUSED_ARG(debuggable);
 
     if (expr) {
        if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
@@ -3757,8 +3754,8 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
        } else if (expr->op_flags & OPf_KIDS) {
-            const OP *k1 = ((UNOP*)expr)->op_first;
-            const OP *k2 = (k1) ? k1->op_sibling : NULL;
+           const OP * const k1 = ((UNOP*)expr)->op_first;
+           const OP * const k2 = k1 ? k1->op_sibling : NULL;
            switch (expr->op_type) {
              case OP_NULL:
                if (k2 && k2->op_type == OP_READLINE
@@ -3810,15 +3807,16 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
     OP *listop;
     OP *o;
     U8 loopflags = 0;
-    (void)debuggable;
+
+    PERL_UNUSED_ARG(debuggable);
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
        expr = newUNOP(OP_DEFINED, 0,
            newASSIGNOP(0, newDEFSVOP(), 0, expr) );
     } else if (expr && (expr->op_flags & OPf_KIDS)) {
-       const OP *k1 = ((UNOP*)expr)->op_first;
-       const OP *k2 = (k1) ? k1->op_sibling : NULL;
+       const OP * const k1 = ((UNOP*)expr)->op_first;
+       const OP * const k2 = (k1) ? k1->op_sibling : NULL;
        switch (expr->op_type) {
          case OP_NULL:
            if (k2 && k2->op_type == OP_READLINE
@@ -3897,7 +3895,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
 }
 
 OP *
-Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
+Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP *block, OP *cont)
 {
     dVAR;
     LOOP *loop;
@@ -3952,8 +3950,8 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
         */
        UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
        LOGOP* range = (LOGOP*) flip->op_first;
-       OP* left  = range->op_first;
-       OP* right = left->op_sibling;
+       OP* const left  = range->op_first;
+       OP* const right = left->op_sibling;
        LISTOP* listop;
 
        range->op_flags &= ~OPf_KIDS;
@@ -4001,7 +3999,6 @@ OP*
 Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 {
     OP *o;
-    STRLEN n_a;
 
     if (type != OP_GOTO || label->op_type == OP_CONST) {
        /* "last()" means "last" */
@@ -4009,7 +4006,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
            o = newOP(type, OPf_SPECIAL);
        else {
            o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
-                                       ? SvPVx(((SVOP*)label)->op_sv, n_a)
+                                       ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
                                        : ""));
        }
        op_free(label);
@@ -4163,7 +4160,7 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
        o = cLISTOPo->op_first->op_sibling;
 
     for (; o; o = o->op_next) {
-       OPCODE type = o->op_type;
+       const OPCODE type = o->op_type;
 
        if (sv && o->op_next == o)
            return sv;
@@ -4210,7 +4207,8 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
 void
 Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
-    (void)floor;
+    PERL_UNUSED_ARG(floor);
+
     if (o)
        SAVEFREEOP(o);
     if (proto)
@@ -4232,25 +4230,25 @@ CV *
 Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dVAR;
-    STRLEN n_a;
     const char *aname;
     GV *gv;
-    char *ps;
+    const char *ps;
     STRLEN ps_len;
     register CV *cv=0;
     SV *const_sv;
+    I32 gv_fetch_flags;
 
-    const char * const name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
+    const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : Nullch;
 
     if (proto) {
        assert(proto->op_type == OP_CONST);
-       ps = SvPVx(((SVOP*)proto)->op_sv, ps_len);
+       ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len);
     }
     else
        ps = Nullch;
 
     if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
-       SV *sv = sv_newmortal();
+       SV * const sv = sv_newmortal();
        Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
                       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
@@ -4258,13 +4256,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
     else
        aname = Nullch;
-    gv = name ? gv_fetchsv(cSVOPo->op_sv,
-                          GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
-                          SVt_PVCV)
+
+    gv_fetch_flags = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
+       ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
+    gv = name ? gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV)
        : gv_fetchpv(aname ? aname
                     : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
-                    GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
-                    SVt_PVCV);
+                    gv_fetch_flags, SVt_PVCV);
 
     if (o)
        SAVEFREEOP(o);
@@ -4301,7 +4299,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
 #endif
 
-    if (!block || !ps || *ps || attrs)
+    if (!block || !ps || *ps || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
        const_sv = Nullsv;
     else
        const_sv = op_const_sv(block, Nullcv);
@@ -4644,24 +4642,32 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
        if (GvCVGEN(gv)) {
            /* just a cached method */
            SvREFCNT_dec(cv);
-           cv = 0;
+           cv = Nullcv;
        }
        else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
            /* already defined (or promised) */
            /* XXX It's possible for this HvNAME_get to return null, and get passed into strEQ */
-           if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
-                           && strEQ(HvNAME_get(GvSTASH(CvGV(cv))), "autouse"))) {
-               const line_t oldline = CopLINE(PL_curcop);
-               if (PL_copline != NOLINE)
-                   CopLINE_set(PL_curcop, PL_copline);
-               Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                           CvCONST(cv) ? "Constant subroutine %s redefined"
-                                       : "Subroutine %s redefined"
-                           ,name);
-               CopLINE_set(PL_curcop, oldline);
+           if (ckWARN(WARN_REDEFINE)) {
+               GV * const gvcv = CvGV(cv);
+               if (gvcv) {
+                   HV * const stash = GvSTASH(gvcv);
+                   if (stash) {
+                       const char *name = HvNAME_get(stash);
+                       if ( strEQ(name,"autouse") ) {
+                           const line_t oldline = CopLINE(PL_curcop);
+                           if (PL_copline != NOLINE)
+                               CopLINE_set(PL_curcop, PL_copline);
+                           Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                                       CvCONST(cv) ? "Constant subroutine %s redefined"
+                                                   : "Subroutine %s redefined"
+                                       ,name);
+                           CopLINE_set(PL_curcop, oldline);
+                       }
+                   }
+               }
            }
            SvREFCNT_dec(cv);
-           cv = 0;
+           cv = Nullcv;
        }
     }
 
@@ -4902,7 +4908,7 @@ Perl_oopsCV(pTHX_ OP *o)
 {
     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
     /* STUB */
-    (void)o;
+    PERL_UNUSED_ARG(o);
     NORETURN_FUNCTION_END;
 }
 
@@ -5066,7 +5072,7 @@ Perl_ck_eval(pTHX_ OP *o)
     dVAR;
     PL_hints |= HINT_BLOCK_SCOPE;
     if (o->op_flags & OPf_KIDS) {
-       SVOP *kid = (SVOP*)cUNOPo->op_first;
+       SVOP * const kid = (SVOP*)cUNOPo->op_first;
 
        if (!kid) {
            o->op_flags &= ~OPf_KIDS;
@@ -5140,7 +5146,7 @@ Perl_ck_exists(pTHX_ OP *o)
 {
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
-       OP *kid = cUNOPo->op_first;
+       OP * const kid = cUNOPo->op_first;
        if (kid->op_type == OP_ENTERSUB) {
            (void) ref(kid, o->op_type);
            if (kid->op_type != OP_RV2CV && !PL_error_count)
@@ -5486,7 +5492,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                           
                                      }
                                      if (tmpstr) {
-                                          name = SvPV(tmpstr, len);
+                                          name = SvPV_const(tmpstr, len);
                                           sv_2mortal(tmpstr);
                                      }
                                 }
@@ -5918,21 +5924,29 @@ Perl_ck_require(pTHX_ OP *o)
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+           SV *sv = kid->op_sv;
+           U32 was_readonly = SvREADONLY(sv);
            char *s;
-           for (s = SvPVX(kid->op_sv); *s; s++) {
+
+           if (was_readonly) {
+               if (SvFAKE(sv)) {
+                   sv_force_normal_flags(sv, 0);
+                   assert(!SvREADONLY(sv));
+                   was_readonly = 0;
+               } else {
+                   SvREADONLY_off(sv);
+               }
+           }   
+
+           for (s = SvPVX(sv); *s; s++) {
                if (*s == ':' && s[1] == ':') {
                    *s = '/';
                    Move(s+2, s+1, strlen(s+2)+1, char);
-                   SvCUR_set(kid->op_sv, SvCUR(kid->op_sv) - 1);
+                   SvCUR_set(sv, SvCUR(sv) - 1);
                }
            }
-           if (SvREADONLY(kid->op_sv)) {
-               SvREADONLY_off(kid->op_sv);
-               sv_catpvn(kid->op_sv, ".pm", 3);
-               SvREADONLY_on(kid->op_sv);
-           }
-           else
-               sv_catpvn(kid->op_sv, ".pm", 3);
+           sv_catpvn(sv, ".pm", 3);
+           SvFLAGS(sv) |= was_readonly;
        }
     }
 
@@ -6178,7 +6192,7 @@ Perl_ck_split(pTHX_ OP *o)
     kid->op_type = OP_PUSHRE;
     kid->op_ppaddr = PL_ppaddr[OP_PUSHRE];
     scalar(kid);
-    if (ckWARN(WARN_REGEXP) && ((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
+    if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL && ckWARN(WARN_REGEXP)) {
       Perl_warner(aTHX_ packWARN(WARN_REGEXP),
                   "Use of /g modifier is meaningless in split");
     }
@@ -6204,9 +6218,9 @@ Perl_ck_split(pTHX_ OP *o)
 OP *
 Perl_ck_join(pTHX_ OP *o)
 {
-    if (ckWARN(WARN_SYNTAX)) {
-       const OP *kid = cLISTOPo->op_first->op_sibling;
-       if (kid && kid->op_type == OP_MATCH) {
+    const OP *kid = cLISTOPo->op_first->op_sibling;
+    if (kid && kid->op_type == OP_MATCH) {
+       if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
            const char *pmstr = re ? re->precomp : "STRING";
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
@@ -6231,7 +6245,6 @@ Perl_ck_subr(pTHX_ OP *o)
     I32 arg = 0;
     I32 contextclass = 0;
     char *e = 0;
-    STRLEN n_a;
     bool delete_op = 0;
 
     o->op_private |= OPpENTERSUB_HASTARG;
@@ -6249,7 +6262,7 @@ Perl_ck_subr(pTHX_ OP *o)
            else {
                if (SvPOK(cv)) {
                    namegv = CvANON(cv) ? gv : CvGV(cv);
-                   proto = SvPV((SV*)cv, n_a);
+                   proto = SvPV_nolen((SV*)cv);
                }
                if (CvASSERTION(cv)) {
                    if (PL_hints & HINT_ASSERTING) {
@@ -6258,7 +6271,7 @@ Perl_ck_subr(pTHX_ OP *o)
                    }
                    else {
                        delete_op = 1;
-                       if (ckWARN(WARN_ASSERTIONS) && !(PL_hints & HINT_ASSERTIONSSEEN)) {
+                       if (!(PL_hints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
                            Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
                                        "Impossible to activate assertion call");
                        }
@@ -6730,8 +6743,9 @@ Perl_peep(pTHX_ register OP *o)
 
        case OP_EXEC:
            o->op_opt = 1;
-           if (ckWARN(WARN_SYNTAX) && o->op_next
-               && o->op_next->op_type == OP_NEXTSTATE) {
+           if (o->op_next && o->op_next->op_type == OP_NEXTSTATE
+               && ckWARN(WARN_SYNTAX))
+           {
                if (o->op_next->op_sibling &&
                        o->op_next->op_sibling->op_type != OP_EXIT &&
                        o->op_next->op_sibling->op_type != OP_WARN &&
@@ -6753,7 +6767,7 @@ Perl_peep(pTHX_ register OP *o)
             SV *lexname;
            GV **fields;
            SV **svp, *sv;
-           char *key = NULL;
+           const char *key = NULL;
            STRLEN keylen;
 
            o->op_opt = 1;
@@ -6764,7 +6778,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)) && !IS_PADCONST(sv)) {
-               key = SvPV(sv, keylen);
+               key = SvPV_const(sv, keylen);
                lexname = newSVpvn_share(key,
                                         SvUTF8(sv) ? -(I32)keylen : keylen,
                                         0);
@@ -6784,13 +6798,13 @@ Perl_peep(pTHX_ register OP *o)
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))
                break;
-           key = SvPV(*svp, keylen);
+           key = SvPV_const(*svp, keylen);
            if (!hv_fetch(GvHV(*fields), key,
                        SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
            {
                Perl_croak(aTHX_ "No such class field \"%s\" " 
                           "in variable %s of type %s", 
-                     key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
+                     key, SvPV_nolen_const(lexname), HvNAME_get(SvSTASH(lexname)));
            }
 
             break;
@@ -6801,7 +6815,7 @@ Perl_peep(pTHX_ register OP *o)
            SV *lexname;
            GV **fields;
            SV **svp;
-           char *key;
+           const char *key;
            STRLEN keylen;
            SVOP *first_key_op, *key_op;
 
@@ -6841,7 +6855,7 @@ Perl_peep(pTHX_ register OP *o)
                if (key_op->op_type != OP_CONST)
                    continue;
                svp = cSVOPx_svp(key_op);
-               key = SvPV(*svp, keylen);
+               key = SvPV_const(*svp, keylen);
                if (!hv_fetch(GvHV(*fields), key, 
                            SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
                {