X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=5dc98a6d3a9038579ade44e4eefa02856bf13bbb;hb=12570a1f39c0588d6ae68281b45ef1b7e6083958;hp=a0953322118835ea81b6b55eafd3fa20cf36431f;hpb=e7d06d42b01cc371aabcd4cee7ef786059ed7a1b;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index a095332..5dc98a6 100644 --- a/Magic.xs +++ b/Magic.xs @@ -770,9 +770,10 @@ STATIC void vmg_uvar_del(SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremagic) STATIC UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args, I32 items) { #define vmg_cast(S, W, WIZ, A, I) vmg_cast(aTHX_ (S), (W), (WIZ), (A), (I)) - MAGIC *mg; - SV *data; - U32 oldgmg; + MAGIC *mg; + MGVTBL *t; + SV *data; + U32 oldgmg; if (vmg_find(sv, w)) return 1; @@ -780,19 +781,22 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args, oldgmg = SvGMAGICAL(sv); data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args, items) : NULL; + + t = vmg_vtable_vtbl(w->vtable); + mg = sv_magicext(sv, data, PERL_MAGIC_ext, t, (const char *) wiz, HEf_SVKEY); + mg->mg_private = 0; + /* sv_magicext() calls mg_magical and increments data's refcount */ - mg = sv_magicext(sv, data, PERL_MAGIC_ext, vmg_vtable_vtbl(w->vtable), - (const char *) wiz, HEf_SVKEY); SvREFCNT_dec(data); - mg->mg_private = 0; - if (w->cb_copy) + + if (t->svt_copy) mg->mg_flags |= MGf_COPY; #if 0 - if (w->cb_dup) + if (t->svt_dup) mg->mg_flags |= MGf_DUP; #endif #if MGf_LOCAL - if (w->cb_local) + if (t->svt_local) mg->mg_flags |= MGf_LOCAL; #endif /* MGf_LOCAL */ @@ -1191,13 +1195,13 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) { return ret; } -STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, -# if VMG_HAS_PERL_MAINT(5, 11, 0, 33256) || VMG_HAS_PERL(5, 12, 0) - I32 keylen -# else - int keylen -# endif - ) { +#if VMG_HAS_PERL_MAINT(5, 11, 0, 33256) || VMG_HAS_PERL(5, 12, 0) +# define VMG_SVT_COPY_KEYLEN_TYPE I32 +#else +# define VMG_SVT_COPY_KEYLEN_TYPE int +#endif + +STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) { const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg); SV *keysv; int ret; @@ -1253,9 +1257,9 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { if (uf[1].uf_set) uf[1].uf_set(aTHX_ action, sv); - action &= HV_FETCH_ISSTORE | HV_FETCH_ISEXISTS | HV_FETCH_LVALUE | HV_DELETE; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const vmg_wizard *w; + switch (mg->mg_type) { case PERL_MAGIC_ext: break; @@ -1265,8 +1269,11 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { default: continue; } + w = vmg_wizard_from_mg(mg); - if (!w) continue; + if (!w) + continue; + switch (w->uvar) { case 0: continue; @@ -1274,7 +1281,9 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { if (!newkey) newkey = key = umg->mg_obj = sv_mortalcopy(umg->mg_obj); } - switch (action) { + + switch (action + & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS|HV_FETCH_LVALUE|HV_DELETE)) { case 0: if (w->cb_fetch) vmg_cb_call2(w->cb_fetch, w->opinfo, sv, mg->mg_obj, key); @@ -1296,21 +1305,21 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { } } - if (SvRMAGICAL(sv) && !tied) { + if (SvRMAGICAL(sv) && !tied && !(action & (HV_FETCH_ISSTORE|HV_DELETE))) { /* Temporarily hide the RMAGICAL flag of the hash so it isn't wrongly * mistaken for a tied hash by the rest of hv_common. It will be reset by * the op_ppaddr of a new fake op injected between the current and the next * one. */ - OP *o = PL_op; - if (!o->op_next || o->op_next->op_ppaddr != vmg_pp_resetuvar) { + OP *nop = PL_op->op_next; + if (!nop || nop->op_ppaddr != vmg_pp_resetuvar) { SVOP *svop; NewOp(1101, svop, 1, SVOP); svop->op_type = OP_STUB; svop->op_ppaddr = vmg_pp_resetuvar; - svop->op_next = o->op_next; + svop->op_next = nop; svop->op_flags = 0; svop->op_sv = sv; - o->op_next = (OP *) svop; + PL_op->op_next = (OP *) svop; } SvRMAGICAL_off(sv); }