X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=0c99f2c6e2694ce1b62b3fce6d44d526c99942cd;hb=ae4a0a994e98c604732190116636b349e7779311;hp=3c4cd3347faa74ceab8869d267110c38e91823d5;hpb=8991ed7c69639359044bebf70ffaf8585b885252;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/Magic.xs b/Magic.xs
index 3c4cd33..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)
@@ -406,11 +412,6 @@ typedef struct {
 
 START_MY_CXT
 
-/* --- Signatures ---------------------------------------------------------- */
-
-#define SIG_WZO ((U16) (0x3891))
-#define SIG_WIZ ((U16) (0x3892))
-
 /* --- <vmg_vtable> structure ---------------------------------------------- */
 
 #if VMG_THREADSAFE
@@ -644,7 +645,7 @@ STATIC SV *vmg_wizard_sv_new(pTHX_ const vmg_wizard *w) {
  if (w) {
   MAGIC *mg = sv_magicext(wiz, NULL, PERL_MAGIC_ext, &vmg_wizard_sv_vtbl,
                                      (const char *) w, 0);
-  mg->mg_private = SIG_WZO;
+  mg->mg_private = 0;
 #if VMG_THREADSAFE
   mg->mg_flags  |= MGf_DUP;
 #endif
@@ -775,9 +776,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;
@@ -785,19 +787,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 = SIG_WIZ;
- 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 */
 
@@ -1196,13 +1201,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;
@@ -1258,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;
@@ -1270,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;
@@ -1279,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);
@@ -1301,21 +1311,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);
  }
@@ -1362,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",
@@ -1370,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));