X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=a3dee91b333de62ba8ea791c0f4d5b35f324d7be;hb=06c0cc96ebd866767a6d107ed78967600f7e0395;hp=37280736617ef819c2d92f391b5b55caf6d4c03b;hpb=8b6b16e72bf4dd30bd09781ad50e9f66fd94440b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 3728073..a3dee91 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 * const ptr = (I32 **) op; + I32 * const slab = ptr[-1]; assert( ptr-1 > (I32 **) slab ); assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) ); assert( *slab > 0 ); @@ -161,7 +161,7 @@ Perl_Slab_Free(pTHX_ void *op) STATIC const char* S_gv_ename(pTHX_ GV *gv) { - SV* tmpsv = sv_newmortal(); + SV* const tmpsv = sv_newmortal(); gv_efullname3(tmpsv, gv, Nullch); return SvPV_nolen_const(tmpsv); } @@ -211,11 +211,13 @@ Perl_allocmy(pTHX_ char *name) PADOFFSET off; /* complain about "my $" etc etc */ - if (!(PL_in_my == KEY_our || + if (*name && + !(PL_in_my == KEY_our || isALPHA(name[1]) || (USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) || - (name[1] == '_' && (*name == '$' || (int)strlen(name) > 2)))) + (name[1] == '_' && (*name == '$' || name[2])))) { + /* name[2] is true if strlen(name) > 2 */ if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) { /* 1999-02-27 mjd@plover.com */ char *p; @@ -404,9 +406,9 @@ Perl_op_clear(pTHX_ OP *o) case OP_QR: clear_pmop: { - HV *pmstash = PmopSTASH(cPMOPo); + HV * const pmstash = PmopSTASH(cPMOPo); if (pmstash && SvREFCNT(pmstash)) { - MAGIC *mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab); + MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab); if (mg) { PMOP *pmop = (PMOP*) mg->mg_obj; PMOP *lastpmop = NULL; @@ -560,7 +562,7 @@ Perl_scalar(pTHX_ OP *o) OP *kid; /* assumes no premature commitment */ - if (!o || (o->op_flags & OPf_WANT) || PL_error_count + if (!o || PL_error_count || (o->op_flags & OPf_WANT) || o->op_type == OP_RETURN) { return o; @@ -804,6 +806,16 @@ Perl_scalarvoid(pTHX_ OP *o) o->op_ppaddr = PL_ppaddr[OP_PREDEC]; break; + case OP_I_POSTINC: + o->op_type = OP_I_PREINC; /* pre-increment is faster */ + o->op_ppaddr = PL_ppaddr[OP_I_PREINC]; + break; + + case OP_I_POSTDEC: + o->op_type = OP_I_PREDEC; /* pre-decrement is faster */ + o->op_ppaddr = PL_ppaddr[OP_I_PREDEC]; + break; + case OP_OR: case OP_AND: case OP_DOR: @@ -1412,7 +1424,7 @@ Perl_refkids(pTHX_ OP *o, I32 type) } OP * -Perl_ref(pTHX_ OP *o, I32 type) +Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref) { dVAR; OP *kid; @@ -1434,12 +1446,12 @@ Perl_ref(pTHX_ OP *o, I32 type) case OP_COND_EXPR: for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) - ref(kid, type); + doref(kid, type, set_op_ref); break; case OP_RV2SV: if (type == OP_DEFINED) o->op_flags |= OPf_SPECIAL; /* don't create GV */ - ref(cUNOPo->op_first, o->op_type); + doref(cUNOPo->op_first, o->op_type, set_op_ref); /* FALL THROUGH */ case OP_PADSV: if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) { @@ -1456,28 +1468,30 @@ Perl_ref(pTHX_ OP *o, I32 type) case OP_RV2AV: case OP_RV2HV: - o->op_flags |= OPf_REF; + if (set_op_ref) + o->op_flags |= OPf_REF; /* FALL THROUGH */ case OP_RV2GV: if (type == OP_DEFINED) o->op_flags |= OPf_SPECIAL; /* don't create GV */ - ref(cUNOPo->op_first, o->op_type); + doref(cUNOPo->op_first, o->op_type, set_op_ref); break; case OP_PADAV: case OP_PADHV: - o->op_flags |= OPf_REF; + if (set_op_ref) + o->op_flags |= OPf_REF; break; case OP_SCALAR: case OP_NULL: if (!(o->op_flags & OPf_KIDS)) break; - ref(cBINOPo->op_first, type); + doref(cBINOPo->op_first, type, set_op_ref); break; case OP_AELEM: case OP_HELEM: - ref(cBINOPo->op_first, o->op_type); + doref(cBINOPo->op_first, o->op_type, set_op_ref); if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) { o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : type == OP_RV2HV ? OPpDEREF_HV @@ -1488,11 +1502,13 @@ Perl_ref(pTHX_ OP *o, I32 type) case OP_SCOPE: case OP_LEAVE: + set_op_ref = FALSE; + /* FALL THROUGH */ case OP_ENTER: case OP_LIST: if (!(o->op_flags & OPf_KIDS)) break; - ref(cLISTOPo->op_last, type); + doref(cLISTOPo->op_last, type, set_op_ref); break; default: break; @@ -1540,7 +1556,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) if (for_my) { /* Don't force the C if we don't need it. */ - SV **svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM, + SV * const * const svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM, sizeof(ATTRSMODULE_PM)-1, 0); if (svp && *svp != &PL_sv_undef) ; /* already in %INC */ @@ -1595,14 +1611,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)), @@ -1643,7 +1652,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, @@ -1683,7 +1692,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) yyerror(Perl_form(aTHX_ "Can't declare %s in %s", OP_DESC(o), PL_in_my == KEY_our ? "our" : "my")); } else if (attrs) { - GV *gv = cGVOPx_gv(cUNOPo->op_first); + GV * const gv = cGVOPx_gv(cUNOPo->op_first); PL_in_my = FALSE; PL_in_my_stash = Nullhv; apply_attrs(GvSTASH(gv), @@ -1774,15 +1783,16 @@ 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)) { - const char *desc = PL_op_desc[(right->op_type == OP_SUBST || + left->op_type == OP_PADHV) + && ckWARN(WARN_MISC)) + { + const char * const desc = PL_op_desc[(right->op_type == OP_SUBST || right->op_type == OP_TRANS) ? right->op_type : OP_MATCH]; - const char *sample = ((left->op_type == OP_RV2AV || + const char * const sample = ((left->op_type == OP_RV2AV || left->op_type == OP_PADAV) ? "@array" : "%hash"); Perl_warner(aTHX_ packWARN(WARN_MISC), @@ -1847,8 +1857,15 @@ Perl_scope(pTHX_ OP *o) o->op_type = OP_SCOPE; o->op_ppaddr = PL_ppaddr[OP_SCOPE]; kid = ((LISTOP*)o)->op_first; - if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { op_null(kid); + + /* The following deals with things like 'do {1 for 1}' */ + kid = kid->op_sibling; + if (kid && + (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)) + op_null(kid); + } } else o = newLISTOP(OP_SCOPE, 0, o, Nullop); @@ -1856,13 +1873,6 @@ Perl_scope(pTHX_ OP *o) return o; } -/* XXX kept for BINCOMPAT only */ -void -Perl_save_hints(pTHX) -{ - Perl_croak(aTHX_ "internal error: obsolete function save_hints() called"); -} - int Perl_block_start(pTHX_ int full) { @@ -1887,7 +1897,7 @@ OP* Perl_block_end(pTHX_ I32 floor, OP *seq) { const int needblockscope = PL_hints & HINT_BLOCK_SCOPE; - OP* retval = scalarseq(seq); + OP* const retval = scalarseq(seq); LEAVE_SCOPE(floor); PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); if (needblockscope) @@ -1904,7 +1914,7 @@ S_newDEFSVOP(pTHX) return newSVREF(newGVOP(OP_GV, 0, PL_defgv)); } else { - OP *o = newOP(OP_PADSV, 0); + OP * const o = newOP(OP_PADSV, 0); o->op_targ = offset; return o; } @@ -1943,7 +1953,7 @@ Perl_newPROG(pTHX_ OP *o) /* Register with debugger */ if (PERLDB_INTER) { - CV *cv = get_cv("DB::postponed", FALSE); + CV * const cv = get_cv("DB::postponed", FALSE); if (cv) { dSP; PUSHMARK(SP); @@ -1967,8 +1977,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; @@ -2275,8 +2285,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) listop->op_first = first; listop->op_last = last; if (type == OP_LIST) { - OP* pushop; - pushop = newOP(OP_PUSHMARK, 0); + OP* const pushop = newOP(OP_PUSHMARK, 0); pushop->op_sibling = first; listop->op_first = pushop; listop->op_flags |= OPf_KIDS; @@ -2321,7 +2330,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first) unop->op_type = (OPCODE)type; unop->op_ppaddr = PL_ppaddr[type]; unop->op_first = first; - unop->op_flags = flags | OPf_KIDS; + unop->op_flags = (U8)(flags | OPf_KIDS); unop->op_private = (U8)(1 | (flags >> 8)); unop = (UNOP*) CHECKOP(type, unop); if (unop->op_next) @@ -2343,7 +2352,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) binop->op_type = (OPCODE)type; binop->op_ppaddr = PL_ppaddr[type]; binop->op_first = first; - binop->op_flags = flags | OPf_KIDS; + binop->op_flags = (U8)(flags | OPf_KIDS); if (!last) { last = first; binop->op_private = (U8)(1 | (flags >> 8)); @@ -2379,24 +2388,21 @@ static int uvcompare(const void *a, const void *b) OP * Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) { - SV *tstr = ((SVOP*)expr)->op_sv; - SV *rstr = ((SVOP*)repl)->op_sv; + SV * const tstr = ((SVOP*)expr)->op_sv; + SV * const rstr = ((SVOP*)repl)->op_sv; STRLEN tlen; STRLEN 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; - I32 complement; - I32 squash; I32 grows = 0; register short *tbl; + const I32 complement = o->op_private & OPpTRANS_COMPLEMENT; + const I32 squash = o->op_private & OPpTRANS_SQUASH; + I32 del = o->op_private & OPpTRANS_DELETE; PL_hints |= HINT_BLOCK_SCOPE; - complement = o->op_private & OPpTRANS_COMPLEMENT; - del = o->op_private & OPpTRANS_DELETE; - squash = o->op_private & OPpTRANS_SQUASH; if (SvUTF8(tstr)) o->op_private |= OPpTRANS_FROM_UTF; @@ -2405,7 +2411,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) o->op_private |= OPpTRANS_TO_UTF; if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) { - SV* listsv = newSVpvn("# comment\n",10); + SV* const listsv = newSVpvn("# comment\n",10); SV* transv = 0; const U8* tend = t + tlen; const U8* rend = r + rlen; @@ -2422,8 +2428,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) I32 bits; I32 havefinal = 0; U32 final = 0; - I32 from_utf = o->op_private & OPpTRANS_FROM_UTF; - I32 to_utf = o->op_private & OPpTRANS_TO_UTF; + const I32 from_utf = o->op_private & OPpTRANS_FROM_UTF; + const I32 to_utf = o->op_private & OPpTRANS_TO_UTF; U8* tsave = NULL; U8* rsave = NULL; @@ -2448,7 +2454,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) { @@ -2491,7 +2497,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); @@ -2643,7 +2649,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) j = rlen - 1; else cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short); - tbl[0x100] = rlen - j; + tbl[0x100] = (short)(rlen - j); for (i=0; i < (I32)rlen - j; i++) tbl[0x101+i] = r[j+i]; } @@ -2702,19 +2708,16 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags) pmop->op_pmflags = pmop->op_pmpermflags; #ifdef USE_ITHREADS - { - SV* repointer; - if(av_len((AV*) PL_regex_pad[0]) > -1) { - repointer = av_pop((AV*)PL_regex_pad[0]); - pmop->op_pmoffset = SvIV(repointer); - SvREPADTMP_off(repointer); - sv_setiv(repointer,0); - } else { - repointer = newSViv(0); - av_push(PL_regex_padav,SvREFCNT_inc(repointer)); - pmop->op_pmoffset = av_len(PL_regex_padav); - PL_regex_pad = AvARRAY(PL_regex_padav); - } + if (av_len((AV*) PL_regex_pad[0]) > -1) { + SV * const repointer = av_pop((AV*)PL_regex_pad[0]); + pmop->op_pmoffset = SvIV(repointer); + SvREPADTMP_off(repointer); + sv_setiv(repointer,0); + } else { + SV * const repointer = newSViv(0); + av_push(PL_regex_padav,SvREFCNT_inc(repointer)); + pmop->op_pmoffset = av_len(PL_regex_padav); + PL_regex_pad = AvARRAY(PL_regex_padav); } #endif @@ -3033,10 +3036,10 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) veop = Nullop; - if (version != Nullop) { - SV *vesv = ((SVOP*)version)->op_sv; + if (version) { + SV * const vesv = ((SVOP*)version)->op_sv; - if (arg == Nullop && !SvNIOKp(vesv)) { + if (!arg && !SvNIOKp(vesv)) { arg = version; } else { @@ -3050,14 +3053,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)), @@ -3070,6 +3066,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) imop = arg; /* no import on explicit () */ else if (SvNIOKp(((SVOP*)idop)->op_sv)) { imop = Nullop; /* use 5.0; */ + if (!aver) + idop->op_private |= OPpCONST_NOVER; } else { SV *meth; @@ -3078,14 +3076,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)), @@ -3094,7 +3086,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, @@ -3166,9 +3158,9 @@ Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...) void Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) { - OP *modname, *veop, *imop; + OP *veop, *imop; - modname = newSVOP(OP_CONST, 0, name); + OP * const modname = newSVOP(OP_CONST, 0, name); modname->op_private |= OPpCONST_BARE; if (ver) { veop = newSVOP(OP_CONST, 0, ver); @@ -3204,14 +3196,18 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) } OP * -Perl_dofile(pTHX_ OP *term) +Perl_dofile(pTHX_ OP *term, I32 force_builtin) { OP *doop; - GV *gv; + GV *gv = Nullgv; - gv = gv_fetchpv("do", FALSE, SVt_PVCV); - if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) - gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV); + if (!force_builtin) { + gv = gv_fetchpv("do", FALSE, SVt_PVCV); + if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { + GV * const * const gvp = (GV**)hv_fetch(PL_globalstash, "do", 2, FALSE); + gv = gvp ? *gvp : Nullgv; + } + } if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, @@ -3294,14 +3290,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 to C, and likewise for hashes */ if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV) @@ -3387,7 +3384,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) if ((tmpop = ((LISTOP*)right)->op_first) && tmpop->op_type == OP_PUSHRE) { - PMOP *pm = (PMOP*)tmpop; + PMOP * const pm = (PMOP*)tmpop; if (left->op_type == OP_RV2AV && !(left->op_private & OPpLVAL_INTRO) && !(o->op_private & OPpASSIGN_COMMON) ) @@ -3438,8 +3435,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; @@ -3499,9 +3495,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) CopSTASH_set(cop, PL_curstash); if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE); - if (svp && *svp != &PL_sv_undef ) { - (void)SvIOK_on(*svp); + SV * const * const svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE); + if (svp && *svp != &PL_sv_undef ) { + (void)SvIOK_on(*svp); SvIV_set(*svp, PTR2IV(cop)); } } @@ -3524,7 +3520,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) LOGOP *logop; OP *o; OP *first = *firstp; - OP *other = *otherp; + OP * const other = *otherp; if (type == OP_XOR) /* Not short circuit, but here by precedence. */ return newBINOP(type, flags, scalar(first), scalar(other)); @@ -3548,7 +3544,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)) || @@ -3584,11 +3580,11 @@ 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 err FOO. */ + else if ((first->op_flags & OPf_KIDS) && type != OP_DOR + && ckWARN(WARN_MISC)) /* [#24076] Don't warn for err FOO. */ { - const OP *k1 = ((UNOP*)first)->op_first; - const OP *k2 = k1->op_sibling; + const OP * const k1 = ((UNOP*)first)->op_first; + const OP * const k2 = k1->op_sibling; OPCODE warnop = 0; switch (first->op_type) { @@ -3635,7 +3631,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) logop->op_type = (OPCODE)type; logop->op_ppaddr = PL_ppaddr[type]; logop->op_first = first; - logop->op_flags = flags | OPf_KIDS; + logop->op_flags = (U8)(flags | OPf_KIDS); logop->op_other = LINKLIST(other); logop->op_private = (U8)(1 | (flags >> 8)); @@ -3668,9 +3664,9 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) scalarboolean(first); if (first->op_type == OP_CONST) { if (first->op_private & OPpCONST_BARE && - first->op_private & OPpCONST_STRICT) { - no_bareword_allowed(first); - } + first->op_private & OPpCONST_STRICT) { + no_bareword_allowed(first); + } if (SvTRUE(((SVOP*)first)->op_sv)) { op_free(first); op_free(falseop); @@ -3686,7 +3682,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) logop->op_type = OP_COND_EXPR; logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR]; logop->op_first = first; - logop->op_flags = flags | OPf_KIDS; + logop->op_flags = (U8)(flags | OPf_KIDS); logop->op_private = (U8)(1 | (flags >> 8)); logop->op_other = LINKLIST(trueop); logop->op_next = LINKLIST(falseop); @@ -3762,7 +3758,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)) @@ -3772,8 +3769,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 @@ -3825,30 +3822,33 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) OP *listop; OP *o; U8 loopflags = 0; - (void)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; - switch (expr->op_type) { - case OP_NULL: - if (k2 && k2->op_type == OP_READLINE - && (k2->op_flags & OPf_STACKED) - && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) - expr = newUNOP(OP_DEFINED, 0, expr); - break; - case OP_SASSIGN: - if (k1->op_type == OP_READDIR - || k1->op_type == OP_GLOB - || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB) - || k1->op_type == OP_EACH) - expr = newUNOP(OP_DEFINED, 0, expr); - break; + PERL_UNUSED_ARG(debuggable); + + if (expr) { + if (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->op_flags & OPf_KIDS) { + 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 + && (k2->op_flags & OPf_STACKED) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + + case OP_SASSIGN: + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB) + || k1->op_type == OP_EACH) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + } } } @@ -3862,7 +3862,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) next = LINKLIST(cont); } if (expr) { - OP *unstack = newOP(OP_UNSTACK, 0); + OP * const unstack = newOP(OP_UNSTACK, 0); if (!next) next = unstack; cont = append_elem(OP_LINESEQ, cont, unstack); @@ -3965,8 +3965,8 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP * set the STACKED flag to indicate that these values are to be * treated as min/max values by 'pp_iterinit'. */ - UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; - LOGOP* range = (LOGOP*) flip->op_first; + UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; + LOGOP* const range = (LOGOP*) flip->op_first; OP* const left = range->op_first; OP* const right = left->op_sibling; LISTOP* listop; @@ -4100,7 +4100,7 @@ void Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p) { if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX_const(cv)))) && ckWARN_d(WARN_PROTOTYPE)) { - SV* msg = sv_newmortal(); + SV* const msg = sv_newmortal(); SV* name = Nullsv; if (gv) @@ -4177,7 +4177,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; @@ -4224,7 +4224,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) @@ -4252,6 +4253,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) STRLEN ps_len; register CV *cv=0; SV *const_sv; + I32 gv_fetch_flags; const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : Nullch; @@ -4263,7 +4265,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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)); @@ -4271,13 +4273,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); @@ -4314,7 +4316,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); @@ -4345,9 +4347,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) SAVEFREESV(PL_compcv); goto done; } - /* ahem, death to those who redefine active sort subs */ - if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv)) - Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name); if (block) { if (ckWARN(WARN_REDEFINE) || (CvCONST(cv) @@ -4507,10 +4506,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) const char *tname = (name ? name : aname); if (PERLDB_SUBLINE && PL_curstash != PL_debstash) { - SV *sv = NEWSV(0,0); - SV *tmpstr = sv_newmortal(); - GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV); - CV *pcv; + SV * const sv = NEWSV(0,0); + SV * const tmpstr = sv_newmortal(); + GV * const db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV); HV *hv; Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld", @@ -4519,14 +4517,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvCUR(tmpstr), sv, 0); hv = GvHVn(db_postponed); - if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr)) - && (pcv = GvCV(db_postponed))) - { - dSP; - PUSHMARK(SP); - XPUSHs(tmpstr); - PUTBACK; - call_sv((SV*)pcv, G_DISCARD); + if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr))) { + CV * const pcv = GvCV(db_postponed); + if (pcv) { + dSP; + PUSHMARK(SP); + XPUSHs(tmpstr); + PUTBACK; + call_sv((SV*)pcv, G_DISCARD); + } } } @@ -4539,8 +4538,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) goto done; if (strEQ(s, "BEGIN") && !PL_error_count) { + dSP; const I32 oldscope = PL_scopestack_ix; ENTER; + PUSHSTACKi(PERLSI_REQUIRE); SAVECOPFILE(&PL_compiling); SAVECOPLINE(&PL_compiling); @@ -4553,6 +4554,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_curcop = &PL_compiling; PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); + POPSTACK; LEAVE; } else if (strEQ(s, "END") && !PL_error_count) { @@ -4645,7 +4647,7 @@ Used by C to hook up XSUBs as Perl subs. CV * Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) { - GV *gv = gv_fetchpv(name ? name : + GV * const gv = gv_fetchpv(name ? name : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"), GV_ADDMULTI, SVt_PVCV); register CV *cv; @@ -4919,15 +4921,6 @@ Perl_newHVREF(pTHX_ OP *o) } OP * -Perl_oopsCV(pTHX_ OP *o) -{ - Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__); - /* STUB */ - (void)o; - NORETURN_FUNCTION_END; -} - -OP * Perl_newCVREF(pTHX_ I32 flags, OP *o) { return newUNOP(OP_RV2CV, flags, scalar(o)); @@ -5035,7 +5028,7 @@ Perl_ck_delete(pTHX_ OP *o) o = ck_fun(o); o->op_private = 0; if (o->op_flags & OPf_KIDS) { - OP *kid = cUNOPo->op_first; + OP * const kid = cUNOPo->op_first; switch (kid->op_type) { case OP_ASLICE: o->op_flags |= OPf_SPECIAL; @@ -5087,7 +5080,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; @@ -5130,9 +5123,9 @@ OP * Perl_ck_exit(pTHX_ OP *o) { #ifdef VMS - HV *table = GvHV(PL_hintgv); + HV * const table = GvHV(PL_hintgv); if (table) { - SV **svp = hv_fetch(table, "vmsish_exit", 11, FALSE); + SV * const * const svp = hv_fetch(table, "vmsish_exit", 11, FALSE); if (svp && *svp && SvTRUE(*svp)) o->op_private |= OPpEXIT_VMSISH; } @@ -5161,7 +5154,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) @@ -5288,10 +5281,10 @@ Perl_ck_ftst(pTHX_ OP *o) /* nothing */ } else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) { - SVOP *kid = (SVOP*)cUNOPo->op_first; + SVOP * const kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newGVOP(type, OPf_REF, + OP * const newop = newGVOP(type, OPf_REF, gv_fetchsv(kid->op_sv, TRUE, SVt_PVIO)); op_free(o); o = newop; @@ -5375,7 +5368,7 @@ Perl_ck_fun(pTHX_ OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newAVREF(newGVOP(OP_GV, 0, + OP * const newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVAV) )); if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), @@ -5394,7 +5387,7 @@ Perl_ck_fun(pTHX_ OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newHVREF(newGVOP(OP_GV, 0, + OP * const newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVHV) )); if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), @@ -5411,7 +5404,7 @@ Perl_ck_fun(pTHX_ OP *o) break; case OA_CVREF: { - OP *newop = newUNOP(OP_NULL, 0, kid); + OP * const newop = newUNOP(OP_NULL, 0, kid); kid->op_sibling = 0; linklist(kid); newop->op_next = newop; @@ -5472,12 +5465,11 @@ Perl_ck_fun(pTHX_ OP *o) else if (kid->op_type == OP_AELEM || kid->op_type == OP_HELEM) { - OP *op; - + OP *op = ((BINOP*)kid)->op_first; name = 0; - if ((op = ((BINOP*)kid)->op_first)) { + if (op) { SV *tmpstr = Nullsv; - const char *a = + const char * const a = kid->op_type == OP_AELEM ? "[]" : "{}"; if (((op->op_type == OP_RV2AV) || @@ -5485,7 +5477,7 @@ Perl_ck_fun(pTHX_ OP *o) (op = ((UNOP*)op)->op_first) && (op->op_type == OP_GV)) { /* packagevar $a[] or $h{} */ - GV *gv = cGVOPx_gv(op); + GV * const gv = cGVOPx_gv(op); if (gv) tmpstr = Perl_newSVpvf(aTHX_ @@ -5496,7 +5488,7 @@ Perl_ck_fun(pTHX_ OP *o) else if (op->op_type == OP_PADAV || op->op_type == OP_PADHV) { /* lexicalvar $a[] or $h{} */ - const char *padname = + const char * const padname = PAD_COMPNAME_PV(op->op_targ); if (padname) tmpstr = @@ -5504,10 +5496,9 @@ Perl_ck_fun(pTHX_ OP *o) "%s%c...%c", padname + 1, a[0], a[1]); - } if (tmpstr) { - name = SvPV(tmpstr, len); + name = SvPV_const(tmpstr, len); sv_2mortal(tmpstr); } } @@ -5793,7 +5784,7 @@ Perl_ck_sassign(pTHX_ OP *o) /* Cannot steal the second time! */ && !(kid->op_private & OPpTARGET_MY)) { - OP *kkid = kid->op_sibling; + OP * const kkid = kid->op_sibling; /* Can just relocate the target. */ if (kkid && kkid->op_type == OP_PADSV @@ -5812,7 +5803,7 @@ Perl_ck_sassign(pTHX_ OP *o) } /* optimise C to C */ if (kid->op_type == OP_UNDEF) { - OP *kkid = kid->op_sibling; + OP * const kkid = kid->op_sibling; if (kkid && kkid->op_type == OP_PADSV && (kkid->op_private & OPpLVAL_INTRO)) { @@ -5844,7 +5835,7 @@ Perl_ck_match(pTHX_ OP *o) OP * Perl_ck_method(pTHX_ OP *o) { - OP *kid = cUNOPo->op_first; + OP * const kid = cUNOPo->op_first; if (kid->op_type == OP_CONST) { SV* sv = kSVOP->op_sv; if (!(strchr(SvPVX_const(sv), ':') || strchr(SvPVX_const(sv), '\''))) { @@ -5872,13 +5863,11 @@ Perl_ck_null(pTHX_ OP *o) OP * Perl_ck_open(pTHX_ OP *o) { - HV *table = GvHV(PL_hintgv); + HV * const table = GvHV(PL_hintgv); if (table) { - SV **svp; - I32 mode; - svp = hv_fetch(table, "open_IN", 7, FALSE); + SV **svp = hv_fetch(table, "open_IN", 7, FALSE); if (svp && *svp) { - mode = mode_from_discipline(*svp); + const I32 mode = mode_from_discipline(*svp); if (mode & O_BINARY) o->op_private |= OPpOPEN_IN_RAW; else if (mode & O_TEXT) @@ -5887,7 +5876,7 @@ Perl_ck_open(pTHX_ OP *o) svp = hv_fetch(table, "open_OUT", 8, FALSE); if (svp && *svp) { - mode = mode_from_discipline(*svp); + const I32 mode = mode_from_discipline(*svp); if (mode & O_BINARY) o->op_private |= OPpOPEN_OUT_RAW; else if (mode & O_TEXT) @@ -5899,8 +5888,8 @@ Perl_ck_open(pTHX_ OP *o) { /* In case of three-arg dup open remove strictness * from the last arg if it is a bareword. */ - OP *first = cLISTOPx(o)->op_first; /* The pushmark. */ - OP *last = cLISTOPx(o)->op_last; /* The bareword. */ + OP * const first = cLISTOPx(o)->op_first; /* The pushmark. */ + OP * const last = cLISTOPx(o)->op_last; /* The bareword. */ OP *oa; const char *mode; @@ -5909,6 +5898,7 @@ Perl_ck_open(pTHX_ OP *o) (last->op_private & OPpCONST_STRICT) && (oa = first->op_sibling) && /* The fh. */ (oa = oa->op_sibling) && /* The mode. */ + (oa->op_type == OP_CONST) && SvPOK(((SVOP*)oa)->op_sv) && (mode = SvPVX_const(((SVOP*)oa)->op_sv)) && mode[0] == '>' && mode[1] == '&' && /* A dup open. */ @@ -5933,13 +5923,13 @@ Perl_ck_repeat(pTHX_ OP *o) OP * Perl_ck_require(pTHX_ OP *o) { - GV* gv; + GV* gv = Nullgv; if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ - SVOP *kid = (SVOP*)cUNOPo->op_first; + SVOP * const kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - SV *sv = kid->op_sv; + SV * const sv = kid->op_sv; U32 was_readonly = SvREADONLY(sv); char *s; @@ -5955,8 +5945,9 @@ Perl_ck_require(pTHX_ OP *o) for (s = SvPVX(sv); *s; s++) { if (*s == ':' && s[1] == ':') { + const STRLEN len = strlen(s+2)+1; *s = '/'; - Move(s+2, s+1, strlen(s+2)+1, char); + Move(s+2, s+1, len, char); SvCUR_set(sv, SvCUR(sv) - 1); } } @@ -5965,13 +5956,17 @@ Perl_ck_require(pTHX_ OP *o) } } - /* handle override, if any */ - gv = gv_fetchpv("require", FALSE, SVt_PVCV); - if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) - gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV); + if (!(o->op_flags & OPf_SPECIAL)) { /* Wasn't written as CORE::require */ + /* handle override, if any */ + gv = gv_fetchpv("require", FALSE, SVt_PVCV); + if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { + GV * const * const gvp = (GV**)hv_fetch(PL_globalstash, "require", 7, FALSE); + gv = gvp ? *gvp : Nullgv; + } + } if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { - OP *kid = cUNOPo->op_first; + OP * const kid = cUNOPo->op_first; cUNOPo->op_first = 0; op_free(o); return ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, @@ -5995,16 +5990,6 @@ Perl_ck_return(pTHX_ OP *o) return o; } -#if 0 -OP * -Perl_ck_retarget(pTHX_ OP *o) -{ - Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__); - /* STUB */ - return o; -} -#endif - OP * Perl_ck_select(pTHX_ OP *o) { @@ -6195,7 +6180,7 @@ Perl_ck_split(pTHX_ OP *o) } if (kid->op_type != OP_MATCH || kid->op_flags & OPf_STACKED) { - OP *sibl = kid->op_sibling; + OP * const sibl = kid->op_sibling; kid->op_sibling = 0; kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, 0); if (cLISTOPo->op_first == cLISTOPo->op_last) @@ -6207,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"); } @@ -6233,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 * const 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), @@ -6286,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"); } @@ -6299,7 +6284,7 @@ Perl_ck_subr(pTHX_ OP *o) if (o2->op_type == OP_CONST) o2->op_private &= ~OPpCONST_STRICT; else if (o2->op_type == OP_LIST) { - OP *o = ((UNOP*)o2)->op_first->op_sibling; + OP * const o = ((UNOP*)o2)->op_first->op_sibling; if (o && o->op_type == OP_CONST) o->op_private &= ~OPpCONST_STRICT; } @@ -6355,9 +6340,9 @@ Perl_ck_subr(pTHX_ OP *o) (gvop = ((UNOP*)gvop)->op_first) && gvop->op_type == OP_GV) { - GV *gv = cGVOPx_gv(gvop); - OP *sibling = o2->op_sibling; - SV *n = newSVpvn("",0); + GV * const gv = cGVOPx_gv(gvop); + OP * const sibling = o2->op_sibling; + SV * const n = newSVpvn("",0); op_free(o2); gv_fullname4(n, gv, "", FALSE); o2 = newSVOP(OP_CONST, 0, n); @@ -6438,8 +6423,8 @@ Perl_ck_subr(pTHX_ OP *o) break; wrapref: { - OP* kid = o2; - OP* sib = kid->op_sibling; + OP* const kid = o2; + OP* const sib = kid->op_sibling; kid->op_sibling = 0; o2 = newUNOP(OP_REFGEN, 0, kid); o2->op_sibling = sib; @@ -6469,7 +6454,7 @@ Perl_ck_subr(pTHX_ OP *o) mod(o2, OP_ENTERSUB); prev = o2; o2 = o2->op_sibling; - } + } /* while */ if (proto && !optional && (*proto && *proto != '@' && *proto != '%' && *proto != ';')) return too_few_arguments(o, gv_ename(namegv)); @@ -6691,10 +6676,10 @@ Perl_peep(pTHX_ register OP *o) } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) { - GV *gv = cGVOPo_gv; + GV * const gv = cGVOPo_gv; if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) { /* XXX could check prototype here instead of just carping */ - SV *sv = sv_newmortal(); + SV * const sv = sv_newmortal(); gv_efullname3(sv, gv, Nullch); Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf"() called too early to check prototype", @@ -6758,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 && @@ -6781,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; @@ -6792,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); @@ -6812,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; @@ -6829,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; @@ -6869,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)) { @@ -6883,22 +6869,22 @@ Perl_peep(pTHX_ register OP *o) case OP_SORT: { /* will point to RV2AV or PADAV op on LHS/RHS of assign */ - OP *oleft, *oright; + OP *oleft; OP *o2; /* check that RHS of sort is a single plain array */ - oright = cUNOPo->op_first; + OP *oright = cUNOPo->op_first; if (!oright || oright->op_type != OP_PUSHMARK) break; /* reverse sort ... can be optimised. */ if (!cUNOPo->op_sibling) { /* Nothing follows us on the list. */ - OP *reverse = o->op_next; + OP * const reverse = o->op_next; if (reverse->op_type == OP_REVERSE && (reverse->op_flags & OPf_WANT) == OPf_WANT_LIST) { - OP *pushmark = cUNOPx(reverse)->op_first; + OP * const pushmark = cUNOPx(reverse)->op_first; if (pushmark && (pushmark->op_type == OP_PUSHMARK) && (cUNOPx(pushmark)->op_sibling == o)) { /* reverse -> pushmark -> sort */