X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ecf05a582e3c4c0f74622847331af430479c4fcb..0fbfbb97fd8bda2b2f51041f575b8e41691c21f0:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index 63e0836..4908525 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -886,6 +886,7 @@ PP(pp_print) /* also used for: pp_rv2hv() */ +/* also called directly by pp_lvavref */ PP(pp_rv2av) { @@ -893,7 +894,8 @@ PP(pp_rv2av) const I32 gimme = GIMME_V; static const char an_array[] = "an ARRAY"; static const char a_hash[] = "a HASH"; - const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV; + const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV + || PL_op->op_type == OP_LVAVREF; const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV; SvGETMAGIC(sv); @@ -941,9 +943,7 @@ PP(pp_rv2av) if (is_pp_rv2av) { AV *const av = MUTABLE_AV(sv); - /* The guts of pp_rv2av, with no intending change to preserve history - (until such time as we get tools that can do blame annotation across - whitespace changes. */ + /* The guts of pp_rv2av */ if (gimme == G_ARRAY) { SP--; PUTBACK; @@ -1071,8 +1071,14 @@ PP(pp_aassign) hash = NULL; while (LIKELY(lelem <= lastlelem)) { + bool alias = FALSE; TAINT_NOT; /* Each item stands on its own, taintwise. */ sv = *lelem++; + if (UNLIKELY(!sv)) { + alias = TRUE; + sv = *lelem++; + ASSUME(SvTYPE(sv) == SVt_PVAV); + } switch (SvTYPE(sv)) { case SVt_PVAV: ary = MUTABLE_AV(sv); @@ -1086,9 +1092,24 @@ PP(pp_aassign) SV **didstore; if (LIKELY(*relem)) SvGETMAGIC(*relem); /* before newSV, in case it dies */ - sv = newSV(0); - sv_setsv_nomg(sv, *relem); - *(relem++) = sv; + if (LIKELY(!alias)) { + sv = newSV(0); + sv_setsv_nomg(sv, *relem); + *relem = sv; + } + else { + if (!SvROK(*relem)) + DIE(aTHX_ "Assigned value is not a reference"); + if (SvTYPE(SvRV(*relem)) > SVt_PVLV) + /* diag_listed_as: Assigned value is not %s reference */ + DIE(aTHX_ + "Assigned value is not a SCALAR reference"); + if (lval) + *relem = sv_mortalcopy(*relem); + /* XXX else check for weak refs? */ + sv = SvREFCNT_inc_simple_NN(SvRV(*relem)); + } + relem++; didstore = av_store(ary,i++,sv); if (magic) { if (!didstore) @@ -1373,7 +1394,7 @@ PP(pp_match) if (PL_op->op_flags & OPf_STACKED) TARG = POPs; - else if (PL_op->op_private & OPpTARGET_MY) + else if (ARGTARG) GETTARGET; else { TARG = DEFSV; @@ -1588,7 +1609,7 @@ Perl_do_readline(pTHX) goto have_fp; } } - fp = nextargv(PL_last_in_gv); + fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL); if (!fp) { /* Note: fp != IoIFP(io) */ (void)do_close(PL_last_in_gv, FALSE); /* now it does*/ } @@ -1675,7 +1696,7 @@ Perl_do_readline(pTHX) { PerlIO_clearerr(fp); if (IoFLAGS(io) & IOf_ARGV) { - fp = nextargv(PL_last_in_gv); + fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL); if (fp) continue; (void)do_close(PL_last_in_gv, FALSE); @@ -1940,6 +1961,11 @@ PP(pp_iter) sv = AvARRAY(av)[ix]; } + if (UNLIKELY(cx->cx_type & CXp_FOR_LVREF)) { + SvSetMagicSV(*itersvp, sv); + break; + } + if (LIKELY(sv)) { if (UNLIKELY(SvIS_FREED(sv))) { *itersvp = NULL; @@ -2072,7 +2098,7 @@ PP(pp_subst) if (PL_op->op_flags & OPf_STACKED) TARG = POPs; - else if (PL_op->op_private & OPpTARGET_MY) + else if (ARGTARG) GETTARGET; else { TARG = DEFSV; @@ -2160,8 +2186,8 @@ PP(pp_subst) if (DO_UTF8(TARG) && !doutf8) { nsv = sv_newmortal(); SvSetSV(nsv, dstr); - if (PL_encoding) - sv_recode_to_utf8(nsv, PL_encoding); + if (IN_ENCODING) + sv_recode_to_utf8(nsv, _get_encoding()); else sv_utf8_upgrade(nsv); c = SvPV_const(nsv, clen); @@ -2341,10 +2367,10 @@ PP(pp_subst) first = FALSE; } else { - if (PL_encoding) { + if (IN_ENCODING) { if (!nsv) nsv = sv_newmortal(); sv_copypv(nsv, repl); - if (!DO_UTF8(nsv)) sv_recode_to_utf8(nsv, PL_encoding); + if (!DO_UTF8(nsv)) sv_recode_to_utf8(nsv, _get_encoding()); sv_catsv(dstr, nsv); } else sv_catsv(dstr, repl); @@ -2967,10 +2993,10 @@ PP(pp_method) PP(pp_method_named) { dSP; - SV* const sv = cSVOP_sv; - U32 hash = SvSHARED_HASH(sv); + SV* const meth = cMETHOPx_meth(PL_op); + U32 hash = SvSHARED_HASH(meth); - XPUSHs(method_common(sv, &hash)); + XPUSHs(method_common(meth, &hash)); RETURN; }