X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/96c2a8ff507ccc5e4a6d00051b23e7a73d844322..089b5c60c035d158afd7e1bbfdd8d9229beea884:/mg.c diff --git a/mg.c b/mg.c index 99169cc..f70a5e9 100644 --- a/mg.c +++ b/mg.c @@ -116,14 +116,12 @@ S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags) mgs = SSPTR(mgs_ix, MGS*); mgs->mgs_sv = sv; mgs->mgs_magical = SvMAGICAL(sv); - mgs->mgs_readonly = SvREADONLY(sv) && !SvIsCOW(sv); + mgs->mgs_readonly = SvREADONLY(sv) != 0; mgs->mgs_ss_ix = PL_savestack_ix; /* points after the saved destructor */ mgs->mgs_bumped = bumped; SvFLAGS(sv) &= ~flags; - /* Turning READONLY off for a copy-on-write scalar (including shared - hash keys) is a bad idea. */ - if (!SvIsCOW(sv)) SvREADONLY_off(sv); + SvREADONLY_off(sv); } #define save_magic(a,b) save_magic_flags(a,b,SVs_GMG|SVs_SMG|SVs_RMG) @@ -397,6 +395,8 @@ S_mg_findext_flags(pTHX_ const SV *sv, int type, const MGVTBL *vtbl, U32 flags) if (sv) { MAGIC *mg; + assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv))); + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) { return mg; @@ -526,7 +526,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic) mg->mg_ptr, mg->mg_len); /* container types should remain read-only across localization */ - if (!SvIsCOW(sv)) SvFLAGS(nsv) |= SvREADONLY(sv); + SvFLAGS(nsv) |= SvREADONLY(sv); } if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) { @@ -661,21 +661,21 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) const REGEXP * const rx = PM_GETRE(PL_curpm); if (rx) { const I32 paren = mg->mg_len; - I32 s; - I32 t; + SSize_t s; + SSize_t t; if (paren < 0) return 0; if (paren <= (I32)RX_NPARENS(rx) && (s = RX_OFFS(rx)[paren].start) != -1 && (t = RX_OFFS(rx)[paren].end) != -1) { - I32 i; + SSize_t i; if (mg->mg_obj) /* @+ */ i = t; else /* @- */ i = s; - if (i > 0 && RX_MATCH_UTF8(rx)) { + if (RX_MATCH_UTF8(rx)) { const char * const b = RX_SUBBEG(rx); if (b) i = RX_SUBCOFFSET(rx) + @@ -683,10 +683,12 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) (U8*)(b-RX_SUBOFFSET(rx)+i)); } - sv_setiv(sv, i); + sv_setuv(sv, i); + return 0; } } } + sv_setsv(sv, NULL); return 0; } @@ -1983,13 +1985,20 @@ int Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) { dVAR; - GV * const gv = PL_DBline; - const I32 i = SvTRUE(sv); - SV ** const svp = av_fetch(GvAV(gv), - atoi(MgPV_nolen_const(mg)), FALSE); + SV **svp; PERL_ARGS_ASSERT_MAGIC_SETDBLINE; + /* The magic ptr/len for the debugger's hash should always be an SV. */ + if (UNLIKELY(mg->mg_len != HEf_SVKEY)) { + Perl_croak(aTHX_ "panic: magic_setdbline len=%"IVdf", ptr='%s'", + mg->mg_len, mg->mg_ptr); + } + + /* Use sv_2iv instead of SvIV() as the former generates smaller code, and + setting/clearing debugger breakpoints is not a hot path. */ + svp = av_fetch(GvAV(PL_DBline), sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); + if (svp && SvIOKp(*svp)) { OP * const o = INT2PTR(OP*,SvIVX(*svp)); if (o) { @@ -1997,7 +2006,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) Slab_to_rw(OpSLAB(o)); #endif /* set or clear breakpoint in the relevant control op */ - if (i) + if (SvTRUE(sv)) o->op_flags |= OPf_SPECIAL; else o->op_flags &= ~OPf_SPECIAL; @@ -2020,7 +2029,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) if (obj) { sv_setiv(sv, AvFILL(obj)); } else { - SvOK_off(sv); + sv_setsv(sv, NULL); } return 0; } @@ -2096,14 +2105,14 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_GETPOS; PERL_UNUSED_ARG(mg); - if (found && found->mg_len >= 0) { - I32 i = found->mg_len; - if (DO_UTF8(lsv)) - sv_pos_b2u(lsv, &i); - sv_setiv(sv, i); + if (found && found->mg_len != -1) { + STRLEN i = found->mg_len; + if (found->mg_flags & MGf_BYTES && DO_UTF8(lsv)) + i = sv_pos_b2u_flags(lsv, i, SV_GMAGIC|SV_CONST_RETURN); + sv_setuv(sv, i); return 0; } - SvOK_off(sv); + sv_setsv(sv,NULL); return 0; } @@ -2149,12 +2158,8 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) else if (pos > (SSize_t)len) pos = len; - if (ulen) { - pos = sv_or_pv_pos_u2b(lsv, s, pos, 0); - } - found->mg_len = pos; - found->mg_flags &= ~MGf_MINMATCH; + found->mg_flags &= ~(MGf_MINMATCH|MGf_BYTES); return 0; } @@ -2284,10 +2289,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_GETVEC; PERL_UNUSED_ARG(mg); - if (lsv) - sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv))); - else - SvOK_off(sv); + sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv))); return 0; } @@ -2301,14 +2303,14 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg) return 0; } -int -Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) +SV * +Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg) { dVAR; SV *targ = NULL; - - PERL_ARGS_ASSERT_MAGIC_GETDEFELEM; - + PERL_ARGS_ASSERT_DEFELEM_TARGET; + if (!mg) mg = mg_find(sv, PERL_MAGIC_defelem); + assert(mg); if (LvTARGLEN(sv)) { if (mg->mg_obj) { SV * const ahv = LvTARG(sv); @@ -2316,10 +2318,10 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) if (he) targ = HeVAL(he); } - else { + else if (LvSTARGOFF(sv) >= 0) { AV *const av = MUTABLE_AV(LvTARG(sv)); - if ((I32)LvTARGOFF(sv) <= AvFILL(av)) - targ = AvARRAY(av)[LvTARGOFF(sv)]; + if (LvSTARGOFF(sv) <= AvFILL(av)) + targ = AvARRAY(av)[LvSTARGOFF(sv)]; } if (targ && (targ != &PL_sv_undef)) { /* somebody else defined it for us */ @@ -2330,10 +2332,18 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) mg->mg_obj = NULL; mg->mg_flags &= ~MGf_REFCOUNTED; } + return targ; } else - targ = LvTARG(sv); - sv_setsv(sv, targ ? targ : &PL_sv_undef); + return LvTARG(sv); +} + +int +Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) +{ + PERL_ARGS_ASSERT_MAGIC_GETDEFELEM; + + sv_setsv(sv, defelem_target(sv, mg)); return 0; } @@ -2370,14 +2380,16 @@ Perl_vivify_defelem(pTHX_ SV *sv) if (!value || value == &PL_sv_undef) Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj)); } + else if (LvSTARGOFF(sv) < 0) + Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv)); else { AV *const av = MUTABLE_AV(LvTARG(sv)); - if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) + if ((I32)LvTARGLEN(sv) < 0 && LvSTARGOFF(sv) > AvFILL(av)) LvTARG(sv) = NULL; /* array can't be extended */ else { - SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE); - if (!svp || (value = *svp) == &PL_sv_undef) - Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv)); + SV* const * const svp = av_fetch(av, LvSTARGOFF(sv), TRUE); + if (!svp || !(value = *svp)) + Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv)); } } SvREFCNT_inc_simple_void(value);