X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=6fb53d49a4c303f56b0e43e120d41c02b6594312;hb=fca1d8b34fac5a740ae67bc3b873bc01cd76a8a9;hp=9d0cf953500f887ece69e0f83399ef1ca513e3a3;hpb=fe578d7fdd84ab0398dc36da7f84e59e1f2bb290;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 9d0cf95..6fb53d4 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -127,15 +127,6 @@ PP(pp_sassign) SV * const temp = left; left = right; right = temp; } - else if (PL_op->op_private & OPpASSIGN_STATE) { - if (SvPADSTALE(right)) - SvPADSTALE_off(right); - else { - (void)POPs; - PUSHs(right); - RETURN; /* ignore assignment */ - } - } if (PL_tainting && PL_tainted && !SvTAINTED(left)) TAINT_NOT; if (PL_op->op_private & OPpASSIGN_CV_TO_GV) { @@ -177,23 +168,44 @@ PP(pp_sassign) if (!got_coderef) { /* We've been returned a constant rather than a full subroutine, but they expect a subroutine reference to apply. */ - ENTER; - SvREFCNT_inc_void(SvRV(cv)); - /* newCONSTSUB takes a reference count on the passed in SV - from us. We set the name to NULL, otherwise we get into - all sorts of fun as the reference to our new sub is - donated to the GV that we're about to assign to. - */ - SvRV_set(left, (SV *)newCONSTSUB(GvSTASH(right), NULL, + if (SvROK(cv)) { + ENTER; + SvREFCNT_inc_void(SvRV(cv)); + /* newCONSTSUB takes a reference count on the passed in SV + from us. We set the name to NULL, otherwise we get into + all sorts of fun as the reference to our new sub is + donated to the GV that we're about to assign to. + */ + SvRV_set(left, (SV *)newCONSTSUB(GvSTASH(right), NULL, SvRV(cv))); - SvREFCNT_dec(cv); - LEAVE; - } + SvREFCNT_dec(cv); + LEAVE; + } else { + /* What can happen for the corner case *{"BONK"} = \&{"BONK"}; + is that + First: ops for \&{"BONK"}; return us the constant in the + symbol table + Second: ops for *{"BONK"} cause that symbol table entry + (and our reference to it) to be upgraded from RV + to typeblob) + Thirdly: We get here. cv is actually PVGV now, and its + GvCV() is actually the subroutine we're looking for + + So change the reference so that it points to the subroutine + of that typeglob, as that's what they were after all along. + */ + GV *const upgraded = (GV *) cv; + CV *const source = GvCV(upgraded); + + assert(source); + assert(CvFLAGS(source) & CVf_CONST); - if (strEQ(GvNAME(right),"isa")) { - GvCVGEN(right) = 0; - ++PL_sub_generation; + SvREFCNT_inc_void(source); + SvREFCNT_dec(upgraded); + SvRV_set(left, (SV *)source); + } } + } SvSetMagicSV(right, left); SETs(right); @@ -440,12 +452,13 @@ PP(pp_defined) --SP; RETURNOP(cLOGOP->op_other); } - } else if (op_type == OP_DEFINED) { + } + else { + /* OP_DEFINED */ sv = POPs; if (!sv || !SvANY(sv)) RETPUSHNO; - } else - DIE(aTHX_ "panic: Invalid op (%s) in pp_defined()", OP_NAME(PL_op)); + } defined = FALSE; switch (SvTYPE(sv)) { @@ -972,13 +985,6 @@ PP(pp_aassign) int duplicates = 0; SV **firsthashrelem = NULL; /* "= 0" keeps gcc 2.95 quiet */ - if (PL_op->op_private & OPpASSIGN_STATE) { - if (SvPADSTALE(*firstlelem)) - SvPADSTALE_off(*firstlelem); - else - RETURN; /* ignore assignment */ - } - PL_delaymagic = DM_DELAY; /* catch simultaneous items */ gimme = GIMME_V; @@ -1025,6 +1031,8 @@ PP(pp_aassign) } TAINT_NOT; } + if (PL_delaymagic & DM_ARRAY) + SvSETMAGIC((SV*)ary); break; case SVt_PVHV: { /* normal hash */ SV *tmpstr; @@ -1171,6 +1179,7 @@ PP(pp_aassign) while (relem <= SP) *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef; } + RETURN; } @@ -1179,7 +1188,7 @@ PP(pp_qr) dVAR; dSP; register PMOP * const pm = cPMOP; REGEXP * rx = PM_GETRE(pm); - SV * const pkg = CALLREG_QRPKG(rx); + SV * const pkg = CALLREG_PACKAGE(rx); SV * const rv = sv_newmortal(); SV * const sv = newSVrv(rv, SvPV_nolen(pkg)); if (rx->extflags & RXf_TAINTED) @@ -1277,9 +1286,12 @@ PP(pp_match) } } } - /* remove comment to get faster /g but possibly unsafe $1 vars after a - match. Test for the unsafe vars will fail as well*/ - if (( /* !global && */ rx->nparens) + /* XXX: comment out !global get safe $1 vars after a + match, BUT be aware that this leads to dramatic slowdowns on + /g matches against large strings. So far a solution to this problem + appears to be quite tricky. + Test for the unsafe vars are TODO for now. */ + if (( !global && rx->nparens) || SvTEMP(TARG) || PL_sawampersand || (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))) r_flags |= REXEC_COPY_STR; @@ -2261,7 +2273,7 @@ PP(pp_subst) register PERL_CONTEXT *cx; SPAGAIN; PUSHSUBST(cx); - RETURNOP(cPMOP->op_pmreplroot); + RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot); } r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST; do { @@ -2721,9 +2733,6 @@ try_autoload: gimme = GIMME_V; if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) { - if (CvASSERTION(cv) && PL_DBassertion) - sv_setiv(PL_DBassertion, 1); - Perl_get_db_sub(aTHX_ &sv, cv); if (CvISXSUB(cv)) PL_curcopdb = PL_curcop; @@ -3030,7 +3039,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) packsv = sv; else { SV* const ref = newSViv(PTR2IV(stash)); - hv_store(PL_stashcache, packname, packlen, ref, 0); + (void)hv_store(PL_stashcache, packname, packlen, ref, 0); } goto fetch; } @@ -3060,7 +3069,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (he) { gv = (GV*)HeVAL(he); if (isGV(gv) && GvCV(gv) && - (!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation)) + (!GvCVGEN(gv) || GvCVGEN(gv) + == (PL_sub_generation + HvMROMETA(stash)->cache_gen))) return (SV*)GvCV(gv); } }