X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=6e0848128ce440659de00d1c4dcc55f97029c840;hb=159e8ad7c747edb4a25db2f2673bbe143531f347;hp=084868613602f3697551fe48b19fff83154b51be;hpb=8654247137887f7bf842faaf1404750813410c7b;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/Magic.xs b/Magic.xs
index 0848686..6e08481 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -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() ........................................... */
 
@@ -784,7 +790,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 +851,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 +949,8 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, const SV *wiz) {
  }
 #endif /* VMG_UVAR */
 
+ vmg_mg_magical(sv);
+
  return 1;
 }