X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=0c99f2c6e2694ce1b62b3fce6d44d526c99942cd;hb=7e4218a22df9d95cb7ee69e807675ec8752caa1e;hp=7fee00e5773d0d1ffb29c8801d6ffb15ce9b4dd1;hpb=6d398b4ceb1bdd5d01a6fbf16f6092444fd4a878;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 7fee00e..0c99f2c 100644 --- a/Magic.xs +++ b/Magic.xs @@ -133,6 +133,12 @@ # define VMG_UVAR 0 #endif +#if VMG_HAS_PERL_MAINT(5, 11, 0, 32969) || VMG_HAS_PERL(5, 12, 0) +# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 1 +#else +# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 0 +#endif + /* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160, partially * reverted to dev-5.11 as 9cdcb38b */ #if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0) @@ -169,10 +175,10 @@ # define VMG_COMPAT_ARRAY_UNDEF_CLEAR 0 #endif -#if VMG_HAS_PERL_MAINT(5, 11, 0, 32969) || VMG_HAS_PERL(5, 12, 0) -# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 1 +#if VMG_HAS_PERL(5, 11, 0) +# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 1 #else -# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 0 +# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0 #endif #if VMG_HAS_PERL(5, 13, 2) @@ -1257,9 +1263,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; @@ -1269,8 +1275,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; @@ -1278,7 +1287,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); @@ -1300,7 +1311,7 @@ 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 @@ -1361,6 +1372,8 @@ BOOT: newCONSTSUB(stash, "MGf_DUP", newSVuv(MGf_DUP)); newCONSTSUB(stash, "MGf_LOCAL", newSVuv(MGf_LOCAL)); newCONSTSUB(stash, "VMG_UVAR", newSVuv(VMG_UVAR)); + newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN", + newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN", newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID", @@ -1369,8 +1382,8 @@ BOOT: newSVuv(VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNDEF_CLEAR", newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR)); - newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN", - newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN)); + newCONSTSUB(stash, "VMG_COMPAT_HASH_DELETE_NOUVAR_VOID", + newSVuv(VMG_COMPAT_HASH_DELETE_NOUVAR_VOID)); newCONSTSUB(stash, "VMG_COMPAT_GLOB_GET", newSVuv(VMG_COMPAT_GLOB_GET)); newCONSTSUB(stash, "VMG_PERL_PATCHLEVEL", newSVuv(VMG_PERL_PATCHLEVEL)); newCONSTSUB(stash, "VMG_THREADSAFE", newSVuv(VMG_THREADSAFE));