Pass the 'data' callback after the 'op_info' flag when calling _wizard()

[perl/modules/Variable-Magic.git] / Magic.xs

diff --git a/Magic.xs b/Magic.xs
index 084868613602f3697551fe48b19fff83154b51be..062cdb30fe595b841a61d0bdb59d1a2a3a623908 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -124,7 +124,7 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 #endif
 
 #ifndef SvREFCNT_inc_simple_void
-# define SvREFCNT_inc_simple_void(sv) SvREFCNT_inc(sv)
+# define SvREFCNT_inc_simple_void(sv) ((void) SvREFCNT_inc(sv))
 #endif
 
 #ifndef mPUSHu
@@ -213,30 +213,36 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 
 /* ... Bug-free mg_magical ................................................. */
 
-/* See the discussion at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html. This version is specialized to our needs. */
+/* See the discussion at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html */
 
-#if VMG_UVAR
+#if VMG_HAS_PERL(5, 11, 3)
+
+#define vmg_mg_magical(S) mg_magical(S)
+
+#else
+
+STATIC void vmg_mg_magical(SV *sv) {
+ const MAGIC *mg;
 
-STATIC void vmg_sv_magicuvar(pTHX_ SV *sv, const char *uf, I32 len) {
-#define vmg_sv_magicuvar(S, U, L) vmg_sv_magicuvar(aTHX_ (S), (U), (L))
- const MAGIC* mg;
- sv_magic(sv, NULL, PERL_MAGIC_uvar, uf, len);
- /* uvar magic has set and get magic, hence this has set SVs_GMG and SVs_SMG. */
+ SvMAGICAL_off(sv);
  if ((mg = SvMAGIC(sv))) {
-  SvRMAGICAL_off(sv);
   do {
    const MGVTBL* const vtbl = mg->mg_virtual;
    if (vtbl) {
-    if (vtbl->svt_clear) {
+    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);
-     break;
-    }
    }
   } while ((mg = mg->mg_moremagic));
+  if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)))
+   SvRMAGICAL_on(sv);
  }
 }
 
-#endif /* VMG_UVAR */
+#endif
 
 /* ... Safe version of call_sv() ........................................... */
 
@@ -353,9 +359,11 @@ STATIC opclass vmg_opclass(const OP *o) {
   return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
 
  if (o->op_type == OP_AELEMFAST) {
+#if PERL_VERSION <= 14
   if (o->op_flags & OPf_SPECIAL)
    return OPc_BASEOP;
   else
+#endif
 #ifdef USE_ITHREADS
    return OPc_PADOP;
 #else
@@ -751,7 +759,7 @@ STATIC SV *vmg_data_get(pTHX_ SV *sv, const SV *wiz) {
 #define vmg_data_get(S, W) vmg_data_get(aTHX_ (S), (W))
  const MAGIC *mg = vmg_find(sv, wiz);
  return mg ? mg->mg_obj : NULL;
-} 
+}
 
 /* ... Magic cast/dispell .................................................. */
 
@@ -784,7 +792,9 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, SV **args, I32 items) {
  oldgmg = SvGMAGICAL(sv);
 
  data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args, items) : NULL;
- mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl, (const char *) wiz, HEf_SVKEY);
+ /* sv_magicext() calls mg_magical and increments data's refcount */
+ mg   = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl,
+                              (const char *) wiz, HEf_SVKEY);
  SvREFCNT_dec(data);
  mg->mg_private = SIG_WIZ;
 #if MGf_COPY
@@ -843,7 +853,8 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, SV **args, I32 items) {
    }
   }
 
-  vmg_sv_magicuvar(sv, (const char *) &uf, sizeof(uf));
+  sv_magic(sv, NULL, PERL_MAGIC_uvar, (const char *) &uf, sizeof(uf));
+  vmg_mg_magical(sv);
   /* Our hash now carries uvar magic. The uvar/clear shortcoming has to be
    * handled by our uvar callback. */
  }
@@ -940,6 +951,8 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, const SV *wiz) {
  }
 #endif /* VMG_UVAR */
 
+ vmg_mg_magical(sv);
+
  return 1;
 }
 
@@ -1456,14 +1469,14 @@ CODE:
  Newx(t, 1, MGVTBL);
  Newx(w, 1, MGWIZ);
 
- VMG_SET_CB(ST(i++), data);
-
  cb = ST(i++);
  opinfo = SvOK(cb) ? SvUV(cb) : 0;
  w->opinfo = (U8) ((opinfo < 255) ? opinfo : 255);
  if (w->opinfo)
   vmg_op_info_init(w->opinfo);
 
+ VMG_SET_CB(ST(i++), data);
+
  VMG_SET_SVT_CB(ST(i++), get);
  VMG_SET_SVT_CB(ST(i++), set);
  VMG_SET_SVT_CB(ST(i++), len);