X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=fae2d6db9b8fc9ffc9129c7efda51d0bfba07cf8;hb=efe15bf0980629945e70e47a4eaaffc5bdc49b7d;hp=38ba12e0de50ffcfb220101c54c2c54d9ce4c959;hpb=ea726b52599b52cf534201a46ec3455418c9eb8e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 38ba12e..fae2d6d 100644 --- 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 @@ -75,23 +78,23 @@ PP(pp_padav) } gimme = GIMME_V; if (gimme == G_ARRAY) { - const I32 maxarg = AvFILL((AV*)TARG) + 1; + const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; EXTEND(SP, maxarg); if (SvMAGICAL(TARG)) { U32 i; for (i=0; i < (U32)maxarg; i++) { - SV * const * const svp = av_fetch((AV*)TARG, i, FALSE); + SV * const * const svp = av_fetch(MUTABLE_AV(TARG), i, FALSE); SP[i+1] = (svp) ? *svp : &PL_sv_undef; } } else { - Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*); + Copy(AvARRAY((const AV *)TARG), SP+1, maxarg, SV*); } SP += maxarg; } else if (gimme == G_SCALAR) { SV* const sv = sv_newmortal(); - const I32 maxarg = AvFILL((AV*)TARG) + 1; + const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; sv_setiv(sv, maxarg); PUSHs(sv); } @@ -137,11 +140,11 @@ PP(pp_rv2gv) sv = SvRV(sv); if (SvTYPE(sv) == SVt_PVIO) { - GV * const gv = (GV*) sv_newmortal(); + GV * const gv = MUTABLE_GV(sv_newmortal()); gv_init(gv, 0, "", 0, 0); - GvIOp(gv) = (IO *)sv; + GvIOp(gv) = MUTABLE_IO(sv); SvREFCNT_inc_void_NN(sv); - sv = (SV*) gv; + sv = MUTABLE_SV(gv); } else if (!isGV_with_GP(sv)) DIE(aTHX_ "Not a GLOB reference"); @@ -158,14 +161,14 @@ 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) { STRLEN len; SV * const namesv = PAD_SV(cUNOP->op_targ); const char * const name = SvPV(namesv, len); - gv = (GV*)newSV(0); + gv = MUTABLE_GV(newSV(0)); gv_init(gv, CopSTASH(PL_curcop), name, len, 0); } else { @@ -173,7 +176,7 @@ PP(pp_rv2gv) gv = newGVgen(name); } prepare_SV_for_RV(sv); - SvRV_set(sv, (SV*)gv); + SvRV_set(sv, MUTABLE_SV(gv)); SvROK_on(sv); SvSETMAGIC(sv); goto wasref; @@ -188,10 +191,11 @@ PP(pp_rv2gv) if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - SV * const temp = (SV*)gv_fetchsv(sv, 0, SVt_PVGV); + SV * const temp = MUTABLE_SV(gv_fetchsv(sv, 0, SVt_PVGV)); if (!temp && (!is_gv_magical_sv(sv,0) - || !(sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV)))) { + || !(sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, + SVt_PVGV))))) { RETSETUNDEF; } sv = temp; @@ -206,12 +210,12 @@ PP(pp_rv2gv) things. */ RETURN; } - sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV); + sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV)); } } } if (PL_op->op_private & OPpLVAL_INTRO) - save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL)); + save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL)); SETs(sv); RETURN; } @@ -283,7 +287,7 @@ PP(pp_rv2sv) } } else { - gv = (GV*)sv; + gv = MUTABLE_GV(sv); if (!isGV_with_GP(gv)) { if (SvGMAGICAL(sv)) { @@ -300,11 +304,11 @@ PP(pp_rv2sv) if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) { if (cUNOP->op_first->op_type == OP_NULL) - sv = save_scalar((GV*)TOPs); + sv = save_scalar(MUTABLE_GV(TOPs)); 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); @@ -316,11 +320,11 @@ PP(pp_rv2sv) PP(pp_av2arylen) { dVAR; dSP; - AV * const av = (AV*)TOPs; - SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av); + AV * const av = MUTABLE_AV(TOPs); + SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av)); if (!*sv) { *sv = newSV_type(SVt_PVMG); - sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, NULL, 0); + sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0); } SETs(*sv); RETURN; @@ -376,7 +380,7 @@ PP(pp_rv2cv) CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags); if (cv) { if (CvCLONE(cv)) - cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv))); + cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); if ((PL_op->op_private & OPpLVAL_INTRO)) { if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE))) cv = GvCV(gv); @@ -389,7 +393,7 @@ PP(pp_rv2cv) } else cv = MUTABLE_CV(&PL_sv_undef); - SETs((SV*)cv); + SETs(MUTABLE_SV(cv)); RETURN; } @@ -474,9 +478,9 @@ PP(pp_anoncode) dVAR; dSP; CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ)); if (CvCLONE(cv)) - cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv))); + cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); EXTEND(SP,1); - PUSHs((SV*)cv); + PUSHs(MUTABLE_SV(cv)); RETURN; } @@ -522,8 +526,8 @@ S_refto(pTHX_ SV *sv) SvREFCNT_inc_void_NN(sv); } else if (SvTYPE(sv) == SVt_PVAV) { - if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv)) - av_reify((AV*)sv); + if (!AvREAL((const AV *)sv) && AvREIFY((const AV *)sv)) + av_reify(MUTABLE_AV(sv)); SvTEMP_off(sv); SvREFCNT_inc_void_NN(sv); } @@ -588,7 +592,7 @@ PP(pp_gelem) SV *sv = POPs; const char * const elem = SvPV_nolen_const(sv); - GV * const gv = (GV*)POPs; + GV * const gv = MUTABLE_GV(POPs); SV * tmpRef = NULL; sv = NULL; @@ -598,33 +602,33 @@ PP(pp_gelem) switch (*elem) { case 'A': if (strEQ(second_letter, "RRAY")) - tmpRef = (SV*)GvAV(gv); + tmpRef = MUTABLE_SV(GvAV(gv)); break; case 'C': if (strEQ(second_letter, "ODE")) - tmpRef = (SV*)GvCVu(gv); + tmpRef = MUTABLE_SV(GvCVu(gv)); break; case 'F': if (strEQ(second_letter, "ILEHANDLE")) { /* finally deprecated in 5.8.0 */ deprecate("*glob{FILEHANDLE}"); - tmpRef = (SV*)GvIOp(gv); + tmpRef = MUTABLE_SV(GvIOp(gv)); } else if (strEQ(second_letter, "ORMAT")) - tmpRef = (SV*)GvFORM(gv); + tmpRef = MUTABLE_SV(GvFORM(gv)); break; case 'G': if (strEQ(second_letter, "LOB")) - tmpRef = (SV*)gv; + tmpRef = MUTABLE_SV(gv); break; case 'H': if (strEQ(second_letter, "ASH")) - tmpRef = (SV*)GvHV(gv); + tmpRef = MUTABLE_SV(GvHV(gv)); break; case 'I': if (*second_letter == 'O' && !elem[2]) - tmpRef = (SV*)GvIOp(gv); + tmpRef = MUTABLE_SV(GvIOp(gv)); break; case 'N': if (strEQ(second_letter, "AME")) @@ -803,7 +807,7 @@ PP(pp_undef) case SVt_NULL: break; case SVt_PVAV: - av_undef((AV*)sv); + av_undef(MUTABLE_AV(sv)); break; case SVt_PVHV: hv_undef(MUTABLE_HV(sv)); @@ -832,18 +836,19 @@ PP(pp_undef) HV *stash; /* undef *Foo:: */ - if((stash = GvHV((GV*)sv)) && HvNAME_get(stash)) + if((stash = GvHV((const GV *)sv)) && HvNAME_get(stash)) mro_isa_changed_in(stash); /* undef *Pkg::meth_name ... */ - else if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash)) + else if(GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv)) + && HvNAME_get(stash)) mro_method_changed_in(stash); - gp_free((GV*)sv); + gp_free(MUTABLE_GV(sv)); Newxz(gp, 1, GP); GvGP(sv) = gp_ref(gp); GvSV(sv) = newSV(0); GvLINE(sv) = CopLINE(PL_curcop); - GvEGV(sv) = (GV*)sv; + GvEGV(sv) = MUTABLE_GV(sv); GvMULTI_on(sv); break; } @@ -865,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) { @@ -882,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) @@ -904,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) @@ -1549,7 +1554,7 @@ PP(pp_repeat) } MARK++; repeatcpy((char*)(MARK + items), (char*)MARK, - items * sizeof(SV*), count - 1); + items * sizeof(const SV *), count - 1); SP += max; } else if (count <= 0) @@ -2431,7 +2436,7 @@ PP(pp_negate) STRLEN len; const char * const s = SvPV_const(sv, len); if (isIDFIRST(*s)) { - sv_setpvn(TARG, "-", 1); + sv_setpvs(TARG, "-"); sv_catsv(TARG, sv); } else if (*s == '+' || *s == '-') { @@ -2445,7 +2450,7 @@ PP(pp_negate) if (SvNOK(sv)) sv_setnv(TARG, -SvNV(sv)); else { - sv_setpvn(TARG, "-", 1); + sv_setpvs(TARG, "-"); sv_catsv(TARG, sv); } } @@ -2548,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 @@ -2564,8 +2569,7 @@ PP(pp_complement) #endif for ( ; anum > 0; anum--, tmps++) *tmps = ~*tmps; - - SETs(TARG); + SETTARG; } RETURN; } @@ -3509,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_ @@ -3894,9 +3898,7 @@ PP(pp_quotemeta) } else sv_setpvn(TARG, s, len); - SETs(TARG); - if (SvSMAGICAL(TARG)) - mg_set(TARG); + SETTARG; RETURN; } @@ -3905,12 +3907,22 @@ PP(pp_quotemeta) PP(pp_aslice) { dVAR; dSP; dMARK; dORIGMARK; - register AV* const av = (AV*)POPs; + register AV *const av = MUTABLE_AV(POPs); register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); 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++) { @@ -3921,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; } @@ -3949,7 +3975,7 @@ PP(pp_aeach) { dVAR; dSP; - AV *array = (AV*)POPs; + AV *array = MUTABLE_AV(POPs); const I32 gimme = GIMME_V; IV *iterp = Perl_av_iter_p(aTHX_ array); const IV current = (*iterp)++; @@ -3975,7 +4001,7 @@ PP(pp_akeys) { dVAR; dSP; - AV *array = (AV*)POPs; + AV *array = MUTABLE_AV(POPs); const I32 gimme = GIMME_V; *Perl_av_iter_p(aTHX_ array) = 0; @@ -4040,12 +4066,195 @@ PP(pp_each) RETURN; } -PP(pp_delete) +STATIC OP * +S_do_delete_local(pTHX) { dVAR; dSP; const I32 gimme = GIMME_V; - const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; + const MAGIC *mg; + HV *stash; + + if (PL_op->op_private & OPpSLICE) { + dMARK; dORIGMARK; + SV * const osv = POPs; + const bool tied = SvRMAGICAL(osv) + && mg_find((const SV *)osv, PERL_MAGIC_tied); + const bool can_preserve = SvCANEXISTDELETE(osv) + || mg_find((const SV *)osv, PERL_MAGIC_env); + const U32 type = SvTYPE(osv); + if (type == SVt_PVHV) { /* hash element */ + HV * const hv = MUTABLE_HV(osv); + while (++MARK <= SP) { + SV * const keysv = *MARK; + SV *sv = NULL; + bool preeminent = TRUE; + if (can_preserve) + preeminent = hv_exists_ent(hv, keysv, 0); + if (tied) { + HE *he = hv_fetch_ent(hv, keysv, 1, 0); + if (he) + sv = HeVAL(he); + else + preeminent = FALSE; + } + else { + sv = hv_delete_ent(hv, keysv, 0, 0); + SvREFCNT_inc_simple_void(sv); /* De-mortalize */ + } + if (preeminent) { + save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM); + if (tied) { + *MARK = sv_mortalcopy(sv); + mg_clear(sv); + } else + *MARK = sv; + } + else { + SAVEHDELETE(hv, keysv); + *MARK = &PL_sv_undef; + } + } + } + else if (type == SVt_PVAV) { /* array element */ + if (PL_op->op_flags & OPf_SPECIAL) { + AV * const av = MUTABLE_AV(osv); + while (++MARK <= SP) { + I32 idx = SvIV(*MARK); + SV *sv = NULL; + bool preeminent = TRUE; + if (can_preserve) + preeminent = av_exists(av, idx); + if (tied) { + SV **svp = av_fetch(av, idx, 1); + if (svp) + sv = *svp; + else + preeminent = FALSE; + } + else { + sv = av_delete(av, idx, 0); + SvREFCNT_inc_simple_void(sv); /* De-mortalize */ + } + if (preeminent) { + save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM); + if (tied) { + *MARK = sv_mortalcopy(sv); + mg_clear(sv); + } else + *MARK = sv; + } + else { + SAVEADELETE(av, idx); + *MARK = &PL_sv_undef; + } + } + } + } + else + DIE(aTHX_ "Not a HASH reference"); + if (gimme == G_VOID) + SP = ORIGMARK; + else if (gimme == G_SCALAR) { + MARK = ORIGMARK; + if (SP > MARK) + *++MARK = *SP; + else + *++MARK = &PL_sv_undef; + SP = MARK; + } + } + else { + SV * const keysv = POPs; + SV * const osv = POPs; + const bool tied = SvRMAGICAL(osv) + && mg_find((const SV *)osv, PERL_MAGIC_tied); + const bool can_preserve = SvCANEXISTDELETE(osv) + || mg_find((const SV *)osv, PERL_MAGIC_env); + const U32 type = SvTYPE(osv); + SV *sv = NULL; + if (type == SVt_PVHV) { + HV * const hv = MUTABLE_HV(osv); + bool preeminent = TRUE; + if (can_preserve) + preeminent = hv_exists_ent(hv, keysv, 0); + if (tied) { + HE *he = hv_fetch_ent(hv, keysv, 1, 0); + if (he) + sv = HeVAL(he); + else + preeminent = FALSE; + } + else { + sv = hv_delete_ent(hv, keysv, 0, 0); + SvREFCNT_inc_simple_void(sv); /* De-mortalize */ + } + if (preeminent) { + save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM); + if (tied) { + SV *nsv = sv_mortalcopy(sv); + mg_clear(sv); + sv = nsv; + } + } + else + SAVEHDELETE(hv, keysv); + } + else if (type == SVt_PVAV) { + if (PL_op->op_flags & OPf_SPECIAL) { + AV * const av = MUTABLE_AV(osv); + I32 idx = SvIV(keysv); + bool preeminent = TRUE; + if (can_preserve) + preeminent = av_exists(av, idx); + if (tied) { + SV **svp = av_fetch(av, idx, 1); + if (svp) + sv = *svp; + else + preeminent = FALSE; + } + else { + sv = av_delete(av, idx, 0); + SvREFCNT_inc_simple_void(sv); /* De-mortalize */ + } + if (preeminent) { + save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM); + if (tied) { + SV *nsv = sv_mortalcopy(sv); + mg_clear(sv); + sv = nsv; + } + } + else + SAVEADELETE(av, idx); + } + else + DIE(aTHX_ "panic: avhv_delete no longer supported"); + } + else + DIE(aTHX_ "Not a HASH reference"); + if (!sv) + sv = &PL_sv_undef; + if (gimme != G_VOID) + PUSHs(sv); + } + + RETURN; +} + +PP(pp_delete) +{ + dVAR; + dSP; + I32 gimme; + I32 discard; + + if (PL_op->op_private & OPpLVAL_INTRO) + return do_delete_local(); + + gimme = GIMME_V; + discard = (gimme == G_VOID) ? G_DISCARD : 0; if (PL_op->op_private & OPpSLICE) { dMARK; dORIGMARK; @@ -4060,7 +4269,7 @@ PP(pp_delete) else if (hvtype == SVt_PVAV) { /* array element */ if (PL_op->op_flags & OPf_SPECIAL) { while (++MARK <= SP) { - SV * const sv = av_delete((AV*)hv, SvIV(*MARK), discard); + SV * const sv = av_delete(MUTABLE_AV(hv), SvIV(*MARK), discard); *MARK = sv ? sv : &PL_sv_undef; } } @@ -4086,7 +4295,7 @@ PP(pp_delete) sv = hv_delete_ent(hv, keysv, discard, 0); else if (SvTYPE(hv) == SVt_PVAV) { if (PL_op->op_flags & OPf_SPECIAL) - sv = av_delete((AV*)hv, SvIV(keysv), discard); + sv = av_delete(MUTABLE_AV(hv), SvIV(keysv), discard); else DIE(aTHX_ "panic: avhv_delete no longer supported"); } @@ -4125,7 +4334,7 @@ PP(pp_exists) } else if (SvTYPE(hv) == SVt_PVAV) { if (PL_op->op_flags & OPf_SPECIAL) { /* array element */ - if (av_exists((AV*)hv, SvIV(tmpsv))) + if (av_exists(MUTABLE_AV(hv), SvIV(tmpsv))) RETPUSHYES; } } @@ -4141,31 +4350,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((SV*)hv, PERL_MAGIC_env) || - ((mg = mg_find((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((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); @@ -4177,17 +4383,12 @@ PP(pp_hslice) } if (localizing) { if (HvNAME_get(hv) && isGV(*svp)) - save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL)); - else { - if (preeminent) - save_helem(hv, keysv, svp); - else { - STRLEN keylen; - const char * const key = SvPV_const(keysv, keylen); - SAVEDELETE(hv, savepvn(key,keylen), - SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); - } - } + save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); + else if (preeminent) + save_helem_flags(hv, keysv, svp, + (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); + else + SAVEHDELETE(hv, keysv); } } *MARK = svp ? *svp : &PL_sv_undef; @@ -4273,7 +4474,7 @@ PP(pp_anonlist) { dVAR; dSP; dMARK; dORIGMARK; const I32 items = SP - MARK; - SV * const av = (SV *) av_make(items, MARK+1); + SV * const av = MUTABLE_SV(av_make(items, MARK+1)); SP = ORIGMARK; /* av_make() might realloc stack_sp */ mXPUSHs((PL_op->op_flags & OPf_SPECIAL) ? newRV_noinc(av) : av); @@ -4296,14 +4497,14 @@ PP(pp_anonhash) } SP = ORIGMARK; mXPUSHs((PL_op->op_flags & OPf_SPECIAL) - ? newRV_noinc((SV*) hv) : (SV*) hv); + ? newRV_noinc(MUTABLE_SV(hv)) : MUTABLE_SV(hv)); RETURN; } PP(pp_splice) { dVAR; dSP; dMARK; dORIGMARK; - register AV *ary = (AV*)*++MARK; + register AV *ary = MUTABLE_AV(*++MARK); register SV **src; register SV **dst; register I32 i; @@ -4312,10 +4513,10 @@ PP(pp_splice) I32 newlen; I32 after; I32 diff; - const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); + const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); if (mg) { - *MARK-- = SvTIED_obj((SV*)ary, mg); + *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg); PUSHMARK(MARK); PUTBACK; ENTER; @@ -4508,11 +4709,11 @@ PP(pp_splice) PP(pp_push) { dVAR; dSP; dMARK; dORIGMARK; dTARGET; - register AV * const ary = (AV*)*++MARK; - const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); + register AV * const ary = MUTABLE_AV(*++MARK); + const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); if (mg) { - *MARK-- = SvTIED_obj((SV*)ary, mg); + *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg); PUSHMARK(MARK); PUTBACK; ENTER; @@ -4520,7 +4721,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; @@ -4531,11 +4734,13 @@ PP(pp_push) av_store(ary, AvFILLp(ary)+1, sv); } if (PL_delaymagic & DM_ARRAY) - mg_set((SV*)ary); + mg_set(MUTABLE_SV(ary)); PL_delaymagic = 0; SP = ORIGMARK; - PUSHi( AvFILLp(ary) + 1 ); + if (OP_GIMME(PL_op, 0) != G_VOID) { + PUSHi( AvFILL(ary) + 1 ); + } } RETURN; } @@ -4544,7 +4749,7 @@ PP(pp_shift) { dVAR; dSP; - AV * const av = (AV*)POPs; + AV * const av = MUTABLE_AV(POPs); SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av); EXTEND(SP, 1); assert (sv); @@ -4557,11 +4762,11 @@ PP(pp_shift) PP(pp_unshift) { dVAR; dSP; dMARK; dORIGMARK; dTARGET; - register AV *ary = (AV*)*++MARK; - const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); + register AV *ary = MUTABLE_AV(*++MARK); + const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); if (mg) { - *MARK-- = SvTIED_obj((SV*)ary, mg); + *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg); PUSHMARK(MARK); PUTBACK; ENTER; @@ -4578,7 +4783,9 @@ PP(pp_unshift) } } SP = ORIGMARK; - PUSHi( AvFILL(ary) + 1 ); + if (GIMME_V != G_VOID) { + PUSHi( AvFILL(ary) + 1 ); + } RETURN; } @@ -4677,11 +4884,13 @@ PP(pp_split) I32 iters = 0; const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (STRLEN)(strend - s); I32 maxiters = slen + 10; + I32 trailing_empty = 0; const char *orig; const I32 origlimit = limit; I32 realarray = 0; I32 base; const I32 gimme = GIMME_V; + const bool gimme_scalar = (GIMME_V == G_SCALAR); const I32 oldsave = PL_savestack_ix; U32 make_mortal = SVs_TEMP; bool multiline = 0; @@ -4703,15 +4912,13 @@ PP(pp_split) #ifdef USE_ITHREADS if (pm->op_pmreplrootu.op_pmtargetoff) { - ary = GvAVn((GV*)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)); + ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff))); } #else if (pm->op_pmreplrootu.op_pmtargetgv) { ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv); } #endif - else if (gimme != G_ARRAY) - ary = GvAVn(PL_defgv); else ary = NULL; if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) { @@ -4720,9 +4927,9 @@ PP(pp_split) av_extend(ary,0); av_clear(ary); SPAGAIN; - if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { + if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)ary, mg)); + XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg)); } else { if (!AvREAL(ary)) { @@ -4782,9 +4989,17 @@ PP(pp_split) if (m >= strend) break; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } /* skip the whitespace found last */ if (do_utf8) @@ -4812,9 +5027,18 @@ PP(pp_split) m++; if (m >= strend) break; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } s = m; } } @@ -4827,34 +5051,49 @@ PP(pp_split) or split //, $str, $i; */ - const U32 items = limit - 1; - if (items < slen) - EXTEND(SP, items); - else - EXTEND(SP, slen); + if (!gimme_scalar) { + const U32 items = limit - 1; + if (items < slen) + EXTEND(SP, items); + else + EXTEND(SP, slen); + } if (do_utf8) { while (--limit) { /* keep track of how many bytes we skip over */ m = s; s += UTF8SKIP(s); - dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal); + if (gimme_scalar) { + iters++; + if (s-m == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal); - PUSHs(dstr); + PUSHs(dstr); + } if (s >= strend) break; } } else { while (--limit) { - dstr = newSVpvn(s, 1); + if (gimme_scalar) { + iters++; + } else { + dstr = newSVpvn(s, 1); - s++; - if (make_mortal) - sv_2mortal(dstr); + if (make_mortal) + sv_2mortal(dstr); - PUSHs(dstr); + PUSHs(dstr); + } + + s++; if (s >= strend) break; @@ -4876,9 +5115,17 @@ PP(pp_split) ; if (m >= strend) break; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } /* The rx->minlen is in characters but we want to step * s ahead by bytes. */ if (do_utf8) @@ -4892,9 +5139,17 @@ PP(pp_split) (m = fbm_instr((unsigned char*)s, (unsigned char*)strend, csv, multiline ? FBMrf_MULTILINE : 0)) ) { - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } /* The rx->minlen is in characters but we want to step * s ahead by bytes. */ if (do_utf8) @@ -4924,9 +5179,18 @@ PP(pp_split) strend = s + (strend - m); } m = RX_OFFS(rx)[0].start + orig; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } if (RX_NPARENS(rx)) { I32 i; for (i = 1; i <= (I32)RX_NPARENS(rx); i++) { @@ -4936,37 +5200,54 @@ PP(pp_split) /* japhy (07/27/01) -- the (m && s) test doesn't catch parens that didn't match -- they should be set to undef, not the empty string */ - if (m >= orig && s >= orig) { - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) - | make_mortal); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + if (m >= orig && s >= orig) { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) + | make_mortal); + } + else + dstr = &PL_sv_undef; /* undef, not "" */ + XPUSHs(dstr); } - else - dstr = &PL_sv_undef; /* undef, not "" */ - XPUSHs(dstr); + } } s = RX_OFFS(rx)[0].end + orig; } } - iters = (SP - PL_stack_base) - base; + if (!gimme_scalar) { + iters = (SP - PL_stack_base) - base; + } if (iters > maxiters) DIE(aTHX_ "Split loop"); /* keep field after final delim? */ if (s < strend || (iters && origlimit)) { - const STRLEN l = strend - s; - dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (!gimme_scalar) { + const STRLEN l = strend - s; + dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } iters++; } else if (!origlimit) { - while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) { - if (TOPs && !make_mortal) - sv_2mortal(TOPs); - iters--; - *SP-- = &PL_sv_undef; + if (gimme_scalar) { + iters -= trailing_empty; + } else { + while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) { + if (TOPs && !make_mortal) + sv_2mortal(TOPs); + *SP-- = &PL_sv_undef; + iters--; + } } } @@ -4977,7 +5258,7 @@ PP(pp_split) if (!mg) { if (SvSMAGICAL(ary)) { PUTBACK; - mg_set((SV*)ary); + mg_set(MUTABLE_SV(ary)); SPAGAIN; } if (gimme == G_ARRAY) { @@ -5034,9 +5315,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);