X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=9cedc3fe47cccca88f1dd5e313601a666124a686;hb=ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52;hp=5b16f2586294950c5d55fd8df2bc916d4dd4c63c;hpb=159b6efe04c56d08ae56a63921b5ab3a69ac2ee9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c old mode 100644 new mode 100755 index 5b16f25..9cedc3f --- a/pp.c +++ b/pp.c @@ -9,8 +9,11 @@ */ /* - * "It's a big house this, and very peculiar. Always a bit more to discover, - * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise + * 'It's a big house this, and very peculiar. Always a bit more + * to discover, and no knowing what you'll find round a corner. + * And Elves, sir!' --Samwise Gamgee + * + * [p.225 of _The Lord of the Rings_, II/i: "Many Meetings"] */ /* This file contains general pp ("push/pop") functions that execute the @@ -158,7 +161,7 @@ PP(pp_rv2gv) * NI-S 1999/05/07 */ if (SvREADONLY(sv)) - Perl_croak(aTHX_ PL_no_modify); + Perl_croak(aTHX_ "%s", PL_no_modify); if (PL_op->op_private & OPpDEREF) { GV *gv; if (cUNOP->op_targ) { @@ -305,7 +308,7 @@ PP(pp_rv2sv) else if (gv) sv = save_scalar(gv); else - Perl_croak(aTHX_ PL_no_localize_ref); + Perl_croak(aTHX_ "%s", PL_no_localize_ref); } else if (PL_op->op_private & OPpDEREF) vivify_ref(sv, PL_op->op_private & OPpDEREF); @@ -867,7 +870,7 @@ PP(pp_predec) { dVAR; dSP; if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs)) - DIE(aTHX_ PL_no_modify); + DIE(aTHX_ "%s", PL_no_modify); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) { @@ -884,7 +887,7 @@ PP(pp_postinc) { dVAR; dSP; dTARGET; if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs)) - DIE(aTHX_ PL_no_modify); + DIE(aTHX_ "%s", PL_no_modify); sv_setsv(TARG, TOPs); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MAX) @@ -906,7 +909,7 @@ PP(pp_postdec) { dVAR; dSP; dTARGET; if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs)) - DIE(aTHX_ PL_no_modify); + DIE(aTHX_ "%s", PL_no_modify); sv_setsv(TARG, TOPs); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) @@ -2550,7 +2553,7 @@ PP(pp_complement) sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL); SvUTF8_off(TARG); } - SETs(TARG); + SETTARG; RETURN; } #ifdef LIBERAL @@ -2566,8 +2569,7 @@ PP(pp_complement) #endif for ( ; anum > 0; anum--, tmps++) *tmps = ~*tmps; - - SETs(TARG); + SETTARG; } RETURN; } @@ -3511,7 +3513,7 @@ PP(pp_crypt) # else sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right))); # endif - SETs(TARG); + SETTARG; RETURN; #else DIE(aTHX_ @@ -3896,9 +3898,7 @@ PP(pp_quotemeta) } else sv_setpvn(TARG, s, len); - SETs(TARG); - if (SvSMAGICAL(TARG)) - mg_set(TARG); + SETTARG; RETURN; } @@ -3912,7 +3912,17 @@ PP(pp_aslice) if (SvTYPE(av) == SVt_PVAV) { const I32 arybase = CopARYBASE_get(PL_curcop); - if (lval && PL_op->op_private & OPpLVAL_INTRO) { + const bool localizing = PL_op->op_private & OPpLVAL_INTRO; + bool can_preserve = FALSE; + + if (localizing) { + MAGIC *mg; + HV *stash; + + can_preserve = SvCANEXISTDELETE(av); + } + + if (lval && localizing) { register SV **svp; I32 max = -1; for (svp = MARK + 1; svp <= SP; svp++) { @@ -3923,18 +3933,32 @@ PP(pp_aslice) if (max > AvMAX(av)) av_extend(av, max); } + while (++MARK <= SP) { register SV **svp; I32 elem = SvIV(*MARK); + bool preeminent = TRUE; if (elem > 0) elem -= arybase; + if (localizing && can_preserve) { + /* If we can determine whether the element exist, + * Try to preserve the existenceness of a tied array + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise. */ + preeminent = av_exists(av, elem); + } + svp = av_fetch(av, elem, lval); if (lval) { if (!svp || *svp == &PL_sv_undef) DIE(aTHX_ PL_no_aelem, elem); - if (PL_op->op_private & OPpLVAL_INTRO) - save_aelem(av, elem, svp); + if (localizing) { + if (preeminent) + save_aelem(av, elem, svp); + else + SAVEADELETE(av, elem); + } } *MARK = svp ? *svp : &PL_sv_undef; } @@ -4143,31 +4167,28 @@ PP(pp_hslice) register HV * const hv = MUTABLE_HV(POPs); register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); const bool localizing = PL_op->op_private & OPpLVAL_INTRO; - bool other_magic = FALSE; + bool can_preserve = FALSE; if (localizing) { MAGIC *mg; HV *stash; - other_magic = mg_find((const SV *)hv, PERL_MAGIC_env) || - ((mg = mg_find((const SV *)hv, PERL_MAGIC_tied)) - /* Try to preserve the existenceness of a tied hash - * element by using EXISTS and DELETE if possible. - * Fallback to FETCH and STORE otherwise */ - && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(hv), mg)))) - && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) - && gv_fetchmethod_autoload(stash, "DELETE", TRUE)); + if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env)) + can_preserve = TRUE; } while (++MARK <= SP) { SV * const keysv = *MARK; SV **svp; HE *he; - bool preeminent = FALSE; - - if (localizing) { - preeminent = SvRMAGICAL(hv) && !other_magic ? 1 : - hv_exists_ent(hv, keysv, 0); + bool preeminent = TRUE; + + if (localizing && can_preserve) { + /* If we can determine whether the element exist, + * try to preserve the existenceness of a tied hash + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise. */ + preeminent = hv_exists_ent(hv, keysv, 0); } he = hv_fetch_ent(hv, keysv, lval, 0); @@ -4182,7 +4203,8 @@ PP(pp_hslice) save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); else { if (preeminent) - save_helem(hv, keysv, svp); + save_helem_flags(hv, keysv, svp, + (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); else { STRLEN keylen; const char * const key = SvPV_const(keysv, keylen); @@ -4522,7 +4544,9 @@ PP(pp_push) LEAVE; SPAGAIN; SP = ORIGMARK; - PUSHi( AvFILL(ary) + 1 ); + if (GIMME_V != G_VOID) { + PUSHi( AvFILL(ary) + 1 ); + } } else { PL_delaymagic = DM_DELAY; @@ -4580,7 +4604,9 @@ PP(pp_unshift) } } SP = ORIGMARK; - PUSHi( AvFILL(ary) + 1 ); + if (GIMME_V != G_VOID) { + PUSHi( AvFILL(ary) + 1 ); + } RETURN; } @@ -5036,9 +5062,9 @@ PP(pp_lock) dSP; dTOPss; SV *retsv = sv; + assert(SvTYPE(retsv) != SVt_PVCV); SvLOCK(sv); - if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV - || SvTYPE(retsv) == SVt_PVCV) { + if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV) { retsv = refto(retsv); } SETs(retsv);