X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/77cb3b015781b8e3c7ee73c313ba18cd16dfb442..2f3f243e7f2fb711af248d55c57fb9e7752e1feb:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index 573f496..cbdcb90 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -362,16 +362,19 @@ PP(pp_eq) PP(pp_preinc) { dVAR; dSP; - if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs)) + const bool inc = + PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC; + if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs))) Perl_croak_no_modify(aTHX); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) - && SvIVX(TOPs) != IV_MAX) + && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN)) { - SvIV_set(TOPs, SvIVX(TOPs) + 1); + SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1)); SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */ - sv_inc(TOPs); + if (inc) sv_inc(TOPs); + else sv_dec(TOPs); SvSETMAGIC(TOPs); return NORMAL; } @@ -768,10 +771,10 @@ PP(pp_rv2av) if (SvROK(sv)) { if (SvAMAGIC(sv)) { sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg); - SPAGAIN; } sv = SvRV(sv); if (SvTYPE(sv) != type) + /* diag_listed_as: Not an ARRAY reference */ DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash); if (PL_op->op_flags & OPf_REF) { SETs(sv); @@ -1612,12 +1615,12 @@ Perl_do_readline(pTHX) mg_get(sv); if (SvROK(sv)) { if (type == OP_RCATLINE) - SvPV_force_nolen(sv); + SvPV_force_nomg_nolen(sv); else sv_unref(sv); } else if (isGV_with_GP(sv)) { - SvPV_force_nolen(sv); + SvPV_force_nomg_nolen(sv); } SvUPGRADE(sv, SVt_PV); tmplen = SvLEN(sv); /* remember if already alloced */ @@ -1630,7 +1633,7 @@ Perl_do_readline(pTHX) offset = 0; if (type == OP_RCATLINE && SvOK(sv)) { if (!SvPOK(sv)) { - SvPV_force_nolen(sv); + SvPV_force_nomg_nolen(sv); } offset = SvCUR(sv); } @@ -1771,7 +1774,7 @@ PP(pp_helem) he = hv_fetch_ent(hv, keysv, lval && !defer, hash); svp = he ? &HeVAL(he) : NULL; if (lval) { - if (!svp || *svp == &PL_sv_undef) { + if (!svp || !*svp || *svp == &PL_sv_undef) { SV* lv; SV* key2; if (!defer) { @@ -1801,7 +1804,7 @@ PP(pp_helem) RETURN; } } - sv = (svp ? *svp : &PL_sv_undef); + sv = (svp && *svp ? *svp : &PL_sv_undef); /* Originally this did a conditional C; this * was to make C possible. * However, it seems no longer to be needed for that purpose, and @@ -1961,7 +1964,7 @@ PP(pp_iter) /* A description of how taint works in pattern matching and substitution. -While the pattern is being assembled/concatenated and them compiled, +While the pattern is being assembled/concatenated and then compiled, PL_tainted will get set if any component of the pattern is tainted, e.g. /.*$tainted/. At the end of pattern compilation, the RXf_TAINTED flag is set on the pattern if PL_tainted is set. @@ -2546,8 +2549,6 @@ PP(pp_entersub) switch (SvTYPE(sv)) { /* This is overwhelming the most common case: */ case SVt_PVGV: - if (!isGV_with_GP(sv)) - DIE(aTHX_ "Not a CODE reference"); we_have_a_glob: if (!(cv = GvCVu((const GV *)sv))) { HV *stash; @@ -2584,7 +2585,7 @@ PP(pp_entersub) if (!sym) DIE(aTHX_ PL_no_usym, "a subroutine"); if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ "Can't use string (\"%.32s\"%s) as a subroutine ref while \"strict refs\" in use", sym, len>32 ? "..." : ""); + DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : ""); cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv)); break; } @@ -2622,8 +2623,8 @@ PP(pp_entersub) /* should call AUTOLOAD now? */ else { try_autoload: - if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), - FALSE))) + if ((autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), + GvNAMEUTF8(gv) ? SVf_UTF8 : 0))) { cv = GvCV(autogv); } @@ -2714,6 +2715,9 @@ try_autoload: MARK++; } } + if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && + !CvLVALUE(cv)) + DIE(aTHX_ "Can't modify non-lvalue subroutine call"); /* warning must come *after* we fully set up the context * stuff so that __WARN__ handlers can safely dounwind() * if they want to @@ -2800,8 +2804,6 @@ PP(pp_aelem) Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", SVfARG(elemsv)); - if (elem > 0) - elem -= CopARYBASE_get(PL_curcop); if (SvTYPE(av) != SVt_PVAV) RETPUSHUNDEF; @@ -2932,9 +2934,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) SV* ob; GV* gv; HV* stash; - const char* packname = NULL; SV *packsv = NULL; - STRLEN packlen; SV * const sv = *(PL_stack_base + TOPMARK + 1); PERL_ARGS_ASSERT_METHOD_COMMON; @@ -2948,6 +2948,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) ob = MUTABLE_SV(SvRV(sv)); else { GV* iogv; + STRLEN packlen; + const char * packname = NULL; bool packname_is_utf8 = FALSE; /* this isn't a reference */ @@ -2975,21 +2977,23 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (!packname || ((UTF8_IS_START(*packname) && DO_UTF8(sv)) ? !isIDFIRST_utf8((U8*)packname) - : !isIDFIRST(*packname) + : !isIDFIRST_L1((U8)*packname) )) { + /* diag_listed_as: Can't call method "%s" without a package or object reference */ Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s", SVfARG(meth), SvOK(sv) ? "without a package or object reference" : "on an undefined value"); } /* assume it's a package name */ - stash = gv_stashpvn(packname, packlen, 0); + stash = gv_stashpvn(packname, packlen, packname_is_utf8 ? SVf_UTF8 : 0); if (!stash) packsv = sv; else { SV* const ref = newSViv(PTR2IV(stash)); - (void)hv_store(PL_stashcache, packname, packlen, ref, 0); + (void)hv_store(PL_stashcache, packname, + packname_is_utf8 ? -(I32)packlen : (I32)packlen, ref, 0); } goto fetch; } @@ -3004,10 +3008,10 @@ S_method_common(pTHX_ SV* meth, U32* hashp) && (ob = MUTABLE_SV(GvIO((const GV *)ob))) && SvOBJECT(ob)))) { - const char * const name = SvPV_nolen_const(meth); - Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference", - (SvSCREAM(meth) && strEQ(name,"isa")) ? "DOES" : - name); + Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference", + SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa")) + ? newSVpvs_flags("DOES", SVs_TEMP) + : meth)); } stash = SvSTASH(ob); @@ -3028,9 +3032,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } } - gv = gv_fetchmethod_flags(stash ? stash : MUTABLE_HV(packsv), - SvPV_nolen_const(meth), - GV_AUTOLOAD | GV_CROAK); + gv = gv_fetchmethod_sv_flags(stash ? stash : MUTABLE_HV(packsv), + meth, GV_AUTOLOAD | GV_CROAK); assert(gv);