X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=c541fd1c2742ae824bca9eca71d2501c7fdb92c4;hb=aec46f14fac1bc74bf8ad4054a6f9674b324f8d2;hp=73f33ff87bb79117a2b54263f423dd6a1f6fbea7;hpb=862a34c634844bb3ea22e5f44bdaf2e973831a89;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 73f33ff..c541fd1 100644
--- 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))
 		{