X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=30ac03599fbb3eaaa75f49577dc0aac6d022adc3;hb=7ee5fac837a8a4ebf1956da1b1d252aa82fe506d;hp=41d283710f31c8670e42692fa2515675793bf3ae;hpb=52b4506763c1e322f848f17908bebdf7672f168e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 41d2837..30ac035 100644 --- a/mg.c +++ b/mg.c @@ -85,6 +85,9 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) { dVAR; MGS* mgs; + + PERL_ARGS_ASSERT_SAVE_MAGIC; + assert(SvMAGICAL(sv)); /* Turning READONLY off for a copy-on-write scalar (including shared hash keys) is a bad idea. */ @@ -118,17 +121,23 @@ void Perl_mg_magical(pTHX_ SV *sv) { const MAGIC* mg; + PERL_ARGS_ASSERT_MG_MAGICAL; PERL_UNUSED_CONTEXT; - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { - const MGVTBL* const vtbl = mg->mg_virtual; - if (vtbl) { - if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) - SvGMAGICAL_on(sv); - if (vtbl->svt_set) - SvSMAGICAL_on(sv); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) - SvRMAGICAL_on(sv); - } + if ((mg = SvMAGIC(sv))) { + SvRMAGICAL_off(sv); + do { + const MGVTBL* const vtbl = mg->mg_virtual; + if (vtbl) { + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) + SvGMAGICAL_on(sv); + if (vtbl->svt_set) + SvSMAGICAL_on(sv); + if (vtbl->svt_clear) + SvRMAGICAL_on(sv); + } + } while ((mg = mg->mg_moremagic)); + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG))) + SvRMAGICAL_on(sv); } } @@ -138,6 +147,7 @@ Perl_mg_magical(pTHX_ SV *sv) STATIC bool S_is_container_magic(const MAGIC *mg) { + assert(mg); switch (mg->mg_type) { case PERL_MAGIC_bm: case PERL_MAGIC_fm: @@ -184,6 +194,8 @@ Perl_mg_get(pTHX_ SV *sv) /* guard against sv having being freed midway by holding a private reference. */ + PERL_ARGS_ASSERT_MG_GET; + /* sv_2mortal has this side effect of turning on the TEMP flag, which can cause the SV's buffer to get stolen (and maybe other stuff). So restore it. @@ -262,6 +274,8 @@ Perl_mg_set(pTHX_ SV *sv) MAGIC* mg; MAGIC* nextmg; + PERL_ARGS_ASSERT_MG_SET; + save_magic(mgs_ix, sv); for (mg = SvMAGIC(sv); mg; mg = nextmg) { @@ -296,6 +310,8 @@ Perl_mg_length(pTHX_ SV *sv) MAGIC* mg; STRLEN len; + PERL_ARGS_ASSERT_MG_LENGTH; + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL * const vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_len) { @@ -308,12 +324,15 @@ Perl_mg_length(pTHX_ SV *sv) } } - if (DO_UTF8(sv)) { + { + /* You can't know whether it's UTF-8 until you get the string again... + */ const U8 *s = (U8*)SvPV_const(sv, len); - len = utf8_length(s, s + len); + + if (DO_UTF8(sv)) { + len = utf8_length(s, s + len); + } } - else - (void)SvPV_const(sv, len); return len; } @@ -322,6 +341,8 @@ Perl_mg_size(pTHX_ SV *sv) { MAGIC* mg; + PERL_ARGS_ASSERT_MG_SIZE; + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_len) { @@ -361,6 +382,8 @@ Perl_mg_clear(pTHX_ SV *sv) const I32 mgs_ix = SSNEW(sizeof(MGS)); MAGIC* mg; + PERL_ARGS_ASSERT_MG_CLEAR; + save_magic(mgs_ix, sv); for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { @@ -410,6 +433,9 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen) { int count = 0; MAGIC* mg; + + PERL_ARGS_ASSERT_MG_COPY; + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){ @@ -447,6 +473,9 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv) { dVAR; MAGIC *mg; + + PERL_ARGS_ASSERT_MG_LOCALIZE; + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; if (!S_is_container_magic(mg)) @@ -483,6 +512,9 @@ Perl_mg_free(pTHX_ SV *sv) { MAGIC* mg; MAGIC* moremagic; + + PERL_ARGS_ASSERT_MG_FREE; + for (mg = SvMAGIC(sv); mg; mg = moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; @@ -500,6 +532,7 @@ Perl_mg_free(pTHX_ SV *sv) SvMAGIC_set(sv, moremagic); } SvMAGIC_set(sv, NULL); + SvMAGICAL_off(sv); return 0; } @@ -511,6 +544,8 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) dVAR; PERL_UNUSED_ARG(sv); + PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT; + if (PL_curpm) { register const REGEXP * const rx = PM_GETRE(PL_curpm); if (rx) { @@ -537,6 +572,9 @@ int Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) { dVAR; + + PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET; + if (PL_curpm) { register const REGEXP * const rx = PM_GETRE(PL_curpm); if (rx) { @@ -571,6 +609,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET; PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); Perl_croak(aTHX_ PL_no_modify); @@ -586,6 +625,8 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) register const REGEXP * rx; const char * const remaining = mg->mg_ptr + 1; + PERL_ARGS_ASSERT_MAGIC_LEN; + switch (*mg->mg_ptr) { case '\020': if (*remaining == '\0') { /* ^P */ @@ -668,6 +709,8 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) void Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv) { + PERL_ARGS_ASSERT_EMULATE_COP_IO; + if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT))) sv_setsv(sv, &PL_sv_undef); else { @@ -701,6 +744,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) const char * const remaining = mg->mg_ptr + 1; const char nextchar = *remaining; + PERL_ARGS_ASSERT_MAGIC_GET; + switch (*mg->mg_ptr) { case '\001': /* ^A */ sv_setsv(sv, PL_bodytarget); @@ -1037,6 +1082,8 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg) { struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; + PERL_ARGS_ASSERT_MAGIC_GETUVAR; + if (uf && uf->uf_val) (*uf->uf_val)(aTHX_ uf->uf_index, sv); return 0; @@ -1051,6 +1098,8 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) const char * const ptr = MgPV_const(mg,klen); my_setenv(ptr, s); + PERL_ARGS_ASSERT_MAGIC_SETENV; + #ifdef DYNAMIC_ENV_FETCH /* We just undefd an environment var. Is a replacement */ /* waiting in the wings? */ @@ -1130,6 +1179,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_CLEARENV; PERL_UNUSED_ARG(sv); my_setenv(MgPV_nolen_const(mg),NULL); return 0; @@ -1139,6 +1189,7 @@ int Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg) { dVAR; + PERL_ARGS_ASSERT_MAGIC_SET_ALL_ENV; PERL_UNUSED_ARG(mg); #if defined(VMS) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); @@ -1161,6 +1212,7 @@ int Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) { dVAR; + PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV; PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); #if defined(VMS) @@ -1186,6 +1238,9 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) dVAR; /* Are we fetching a signal entry? */ const I32 i = whichsig(MgPV_nolen_const(mg)); + + PERL_ARGS_ASSERT_MAGIC_GETSIG; + if (i > 0) { if(PL_psig_ptr[i]) sv_setsv(sv,PL_psig_ptr[i]); @@ -1218,6 +1273,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) */ dVAR; register const char * const s = MgPV_nolen_const(mg); + PERL_ARGS_ASSERT_MAGIC_CLEARSIG; PERL_UNUSED_ARG(sv); if (*s == '_') { SV** svp = NULL; @@ -1274,35 +1330,6 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) return 0; } -/* - * The signal handling nomenclature has gotten a bit confusing since the advent of - * safe signals. S_raise_signal only raises signals by analogy with what the - * underlying system's signal mechanism does. It might be more proper to say that - * it defers signals that have already been raised and caught. - * - * PL_sig_pending and PL_psig_pend likewise do not track signals that are pending - * in the sense of being on the system's signal queue in between raising and delivery. - * They are only pending on Perl's deferral list, i.e., they track deferred signals - * awaiting delivery after the current Perl opcode completes and say nothing about - * signals raised but not yet caught in the underlying signal implementation. - */ - -#ifndef SIG_PENDING_DIE_COUNT -# define SIG_PENDING_DIE_COUNT 120 -#endif - -static void -S_raise_signal(pTHX_ int sig) -{ - dVAR; - /* Set a flag to say this signal is pending */ - PL_psig_pend[sig]++; - /* And one to say _a_ signal is pending */ - if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) - Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded", - (unsigned long)SIG_PENDING_DIE_COUNT); -} - Signal_t #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) Perl_csighandler(int sig, siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSED_DECL) @@ -1315,8 +1342,6 @@ Perl_csighandler(int sig) #else dTHX; #endif -#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) -#endif #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS (void) rsignal(sig, PL_csighandlerp); if (PL_sig_ignoring[sig]) return; @@ -1329,9 +1354,7 @@ Perl_csighandler(int sig) exit(1); #endif #endif -#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) -#endif - if ( + if ( #ifdef SIGILL sig == SIGILL || #endif @@ -1349,8 +1372,19 @@ Perl_csighandler(int sig) #else (*PL_sighandlerp)(sig); #endif - else - S_raise_signal(aTHX_ sig); + else { + /* Set a flag to say this signal is pending, that is awaiting delivery after + * the current Perl opcode completes */ + PL_psig_pend[sig]++; + +#ifndef SIG_PENDING_DIE_COUNT +# define SIG_PENDING_DIE_COUNT 120 +#endif + /* And one to say _a_ signal is pending */ + if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) + Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded", + (unsigned long)SIG_PENDING_DIE_COUNT); + } } #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) @@ -1411,8 +1445,10 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) sigset_t set, save; SV* save_sv; #endif - register const char *s = MgPV_const(mg,len); + + PERL_ARGS_ASSERT_MAGIC_SETSIG; + if (*s == '_') { if (strEQ(s,"__DIE__")) svp = &PL_diehook; @@ -1461,7 +1497,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) PL_psig_name[i] = newSVpvn(s, len); SvREADONLY_on(PL_psig_name[i]); } - if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) { + if (isGV_with_GP(sv) || SvROK(sv)) { if (i) { (void)rsignal(i, PL_csighandlerp); #ifdef HAS_SIGPROCMASK @@ -1503,7 +1539,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) * tell whether HINT_STRICT_REFS is in force or not. */ if (!strchr(s,':') && !strchr(s,'\'')) - Perl_sv_insert(aTHX_ sv, 0, 0, STR_WITH_LEN("main::")); + Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"), + SV_GMAGIC); if (i) (void)rsignal(i, PL_csighandlerp); else @@ -1524,6 +1561,8 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) { dVAR; HV* stash; + + PERL_ARGS_ASSERT_MAGIC_SETISA; PERL_UNUSED_ARG(sv); /* Bail out if destruction is going on */ @@ -1544,10 +1583,11 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) stash = GvSTASH( SvTYPE(mg->mg_obj) == SVt_PVGV ? (GV*)mg->mg_obj - : (GV*)SvMAGIC(mg->mg_obj)->mg_obj + : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj ); - mro_isa_changed_in(stash); + if (stash) + mro_isa_changed_in(stash); return 0; } @@ -1558,6 +1598,8 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg) dVAR; HV* stash; + PERL_ARGS_ASSERT_MAGIC_CLEARISA; + /* Bail out if destruction is going on */ if(PL_dirty) return 0; @@ -1567,10 +1609,11 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg) stash = GvSTASH( SvTYPE(mg->mg_obj) == SVt_PVGV ? (GV*)mg->mg_obj - : (GV*)SvMAGIC(mg->mg_obj)->mg_obj + : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj ); - mro_isa_changed_in(stash); + if (stash) + mro_isa_changed_in(stash); return 0; } @@ -1579,6 +1622,7 @@ int Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg) { dVAR; + PERL_ARGS_ASSERT_MAGIC_SETAMAGIC; PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); PL_amagic_generation++; @@ -1591,6 +1635,8 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) { HV * const hv = (HV*)LvTARG(sv); I32 i = 0; + + PERL_ARGS_ASSERT_MAGIC_GETNKEYS; PERL_UNUSED_ARG(mg); if (hv) { @@ -1610,6 +1656,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_SETNKEYS; PERL_UNUSED_ARG(mg); if (LvTARG(sv)) { hv_ksplit((HV*)LvTARG(sv), SvIV(sv)); @@ -1624,6 +1671,8 @@ S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int dVAR; dSP; + PERL_ARGS_ASSERT_MAGIC_METHCALL; + PUSHMARK(SP); EXTEND(SP, n); PUSHs(SvTIED_obj(sv, mg)); @@ -1651,6 +1700,8 @@ S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth) { dVAR; dSP; + PERL_ARGS_ASSERT_MAGIC_METHPACK; + ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); @@ -1668,6 +1719,8 @@ S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth) int Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_GETPACK; + if (mg->mg_ptr) mg->mg_flags |= MGf_GSKIP; magic_methpack(sv,mg,"FETCH"); @@ -1678,6 +1731,9 @@ int Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg) { dVAR; dSP; + + PERL_ARGS_ASSERT_MAGIC_SETPACK; + ENTER; PUSHSTACKi(PERLSI_MAGIC); magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); @@ -1689,6 +1745,8 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_CLEARPACK; + return magic_methpack(sv,mg,"DELETE"); } @@ -1699,6 +1757,8 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg) dVAR; dSP; I32 retval = 0; + PERL_ARGS_ASSERT_MAGIC_SIZEPACK; + ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); @@ -1719,6 +1779,8 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg) { dVAR; dSP; + PERL_ARGS_ASSERT_MAGIC_WIPEPACK; + ENTER; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -1737,6 +1799,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) dVAR; dSP; const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; + PERL_ARGS_ASSERT_MAGIC_NEXTPACK; + ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); @@ -1759,6 +1823,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) int Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_EXISTSPACK; + return magic_methpack(sv,mg,"EXISTS"); } @@ -1770,6 +1836,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) SV * const tied = SvTIED_obj((SV*)hv, mg); HV * const pkg = SvSTASH((SV*)SvRV(tied)); + PERL_ARGS_ASSERT_MAGIC_SCALARPACK; + if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) { SV *key; if (HvEITER_get(hv)) @@ -1807,6 +1875,9 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) const I32 i = SvTRUE(sv); SV ** const svp = av_fetch(GvAV(gv), atoi(MgPV_nolen_const(mg)), FALSE); + + PERL_ARGS_ASSERT_MAGIC_SETDBLINE; + if (svp && SvIOKp(*svp)) { OP * const o = INT2PTR(OP*,SvIVX(*svp)); if (o) { @@ -1825,6 +1896,9 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) { dVAR; const AV * const obj = (AV*)mg->mg_obj; + + PERL_ARGS_ASSERT_MAGIC_GETARYLEN; + if (obj) { sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop)); } else { @@ -1838,6 +1912,9 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) { dVAR; AV * const obj = (AV*)mg->mg_obj; + + PERL_ARGS_ASSERT_MAGIC_SETARYLEN; + if (obj) { av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop)); } else { @@ -1852,7 +1929,10 @@ int Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg) { dVAR; + + PERL_ARGS_ASSERT_MAGIC_FREEARYLEN_P; PERL_UNUSED_ARG(sv); + /* during global destruction, mg_obj may already have been freed */ if (PL_in_clean_all) return 0; @@ -1875,6 +1955,8 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) { dVAR; SV* const lsv = LvTARG(sv); + + PERL_ARGS_ASSERT_MAGIC_GETPOS; PERL_UNUSED_ARG(mg); if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { @@ -1901,6 +1983,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) STRLEN ulen = 0; MAGIC* found; + PERL_ARGS_ASSERT_MAGIC_SETPOS; PERL_UNUSED_ARG(mg); if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) @@ -1959,6 +2042,8 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) const char * const tmps = SvPV_const(lsv,len); I32 offs = LvTARGOFF(sv); I32 rem = LvTARGLEN(sv); + + PERL_ARGS_ASSERT_MAGIC_GETSUBSTR; PERL_UNUSED_ARG(mg); if (SvUTF8(lsv)) @@ -1982,6 +2067,8 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) SV * const lsv = LvTARG(sv); I32 lvoff = LvTARGOFF(sv); I32 lvlen = LvTARGLEN(sv); + + PERL_ARGS_ASSERT_MAGIC_SETSUBSTR; PERL_UNUSED_ARG(mg); if (DO_UTF8(sv)) { @@ -2012,7 +2099,10 @@ int Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) { dVAR; + + PERL_ARGS_ASSERT_MAGIC_GETTAINT; PERL_UNUSED_ARG(sv); + TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1)); return 0; } @@ -2021,7 +2111,10 @@ int Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg) { dVAR; + + PERL_ARGS_ASSERT_MAGIC_SETTAINT; PERL_UNUSED_ARG(sv); + /* update taint status */ if (PL_tainted) mg->mg_len |= 1; @@ -2034,6 +2127,8 @@ int Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) { SV * const lsv = LvTARG(sv); + + PERL_ARGS_ASSERT_MAGIC_GETVEC; PERL_UNUSED_ARG(mg); if (lsv) @@ -2047,6 +2142,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_SETVEC; PERL_UNUSED_ARG(mg); do_vecset(sv); /* XXX slurp this routine */ return 0; @@ -2057,6 +2153,9 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) { dVAR; SV *targ = NULL; + + PERL_ARGS_ASSERT_MAGIC_GETDEFELEM; + if (LvTARGLEN(sv)) { if (mg->mg_obj) { SV * const ahv = LvTARG(sv); @@ -2088,6 +2187,7 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_SETDEFELEM; PERL_UNUSED_ARG(mg); if (LvTARGLEN(sv)) vivify_defelem(sv); @@ -2105,6 +2205,8 @@ Perl_vivify_defelem(pTHX_ SV *sv) MAGIC *mg; SV *value = NULL; + PERL_ARGS_ASSERT_VIVIFY_DEFELEM; + if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem))) return; if (mg->mg_obj) { @@ -2137,12 +2239,14 @@ Perl_vivify_defelem(pTHX_ SV *sv) int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS; return Perl_sv_kill_backrefs(aTHX_ sv, (AV*)mg->mg_obj); } int Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_SETMGLOB; PERL_UNUSED_CONTEXT; mg->mg_len = -1; SvSCREAM_off(sv); @@ -2154,6 +2258,8 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg) { const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; + PERL_ARGS_ASSERT_MAGIC_SETUVAR; + if (uf && uf->uf_set) (*uf->uf_set)(aTHX_ uf->uf_index, sv); return 0; @@ -2163,6 +2269,9 @@ int Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) { const char type = mg->mg_type; + + PERL_ARGS_ASSERT_MAGIC_SETREGEXP; + if (type == PERL_MAGIC_qr) { } else if (type == PERL_MAGIC_bm) { SvTAIL_off(sv); @@ -2178,6 +2287,8 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_SETCOLLXFRM; + /* * RenE Descartes said "I think not." * and vanished with a faint plop. @@ -2197,6 +2308,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg) { + PERL_ARGS_ASSERT_MAGIC_SETUTF8; PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(sv); Safefree(mg->mg_ptr); /* The mg_ptr holds the pos cache. */ @@ -2216,6 +2328,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) I32 i; STRLEN len; + PERL_ARGS_ASSERT_MAGIC_SET; + switch (*mg->mg_ptr) { case '\015': /* $^MATCH */ if (strEQ(remaining, "ATCH")) @@ -2739,6 +2853,8 @@ I32 Perl_whichsig(pTHX_ const char *sig) { register char* const* sigv; + + PERL_ARGS_ASSERT_WHICHSIG; PERL_UNUSED_CONTEXT; for (sigv = (char* const*)PL_sig_name; *sigv; sigv++) @@ -2962,6 +3078,8 @@ S_unwind_handler_stack(pTHX_ const void *p) dVAR; const U32 flags = *(const U32*)p; + PERL_ARGS_ASSERT_UNWIND_HANDLER_STACK; + if (flags & 1) PL_savestack_ix -= 5; /* Unprotect save in progress. */ #if !defined(PERL_IMPLICIT_CONTEXT) @@ -2987,6 +3105,8 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg) SV *key = (mg->mg_len == HEf_SVKEY) ? (SV *)mg->mg_ptr : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP); + PERL_ARGS_ASSERT_MAGIC_SETHINT; + /* mg->mg_obj isn't being used. If needed, it would be possible to store an alternative leaf in there, with PL_compiling.cop_hints being used if it's NULL. If needed for threads, the alternative could lock a mutex, @@ -3002,7 +3122,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg) } /* -=for apidoc magic_sethint +=for apidoc magic_clearhint Triggered by a delete from %^H, records the key to C. @@ -3013,6 +3133,8 @@ int Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg) { dVAR; + + PERL_ARGS_ASSERT_MAGIC_CLEARHINT; PERL_UNUSED_ARG(sv); assert(mg->mg_len == HEf_SVKEY);