From: Vincent Pit <vince@profvince.com>
Date: Sat, 28 Feb 2009 14:49:30 +0000 (+0100)
Subject: Don't store the sig in the mg_private field
X-Git-Tag: v0.32~8
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=9437b104a81a44b562437da8d5d3c64b61b6a29a

Don't store the sig in the mg_private field
---

diff --git a/Magic.xs b/Magic.xs
index 9772cd7..0def957 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -315,10 +315,12 @@ START_MY_CXT
 
 /* --- Signatures ---------------------------------------------------------- */
 
-#define SIG_MIN ((U16) (1u << 8))
+#define SIG_MIN ((U16) 0u)
 #define SIG_MAX ((U16) ((1u << 16) - 1))
 #define SIG_NBR (SIG_MAX - SIG_MIN + 1)
-#define SIG_WIZ ((U16) ((1u << 8) - 1))
+
+#define SIG_WZO ((U16) (0x3891))
+#define SIG_WIZ ((U16) (0x3892))
 
 /* ... Generate signatures ................................................. */
 
@@ -408,9 +410,14 @@ STATIC SV *vmg_data_get(SV *sv, U16 sig) {
  if (SvTYPE(sv) >= SVt_PVMG) {
   for (mg = SvMAGIC(sv); mg; mg = moremagic) {
    moremagic = mg->mg_moremagic;
-   if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == sig)) { break; }
+   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
+    MGWIZ *w = SV2MGWIZ(mg->mg_ptr);
+    if (w->sig == sig)
+     break;
+   }
   }
-  if (mg) { return mg->mg_obj; }
+  if (mg)
+   return mg->mg_obj;
  }
 
  return NULL;
@@ -445,14 +452,19 @@ STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
  if (SvTYPE(sv) >= SVt_PVMG) {
   for (mg = SvMAGIC(sv); mg; mg = moremagic) {
    moremagic = mg->mg_moremagic;
-   if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == w->sig)) { break; }
+   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
+    MGWIZ *z = SV2MGWIZ(mg->mg_ptr);
+    if (z->sig == w->sig)
+     break;
+   }
   }
-  if (mg) { return 1; }
+  if (mg)
+   return 1;
  }
 
  data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args) : NULL;
  mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl, (const char *) wiz, HEf_SVKEY);
- mg->mg_private = w->sig;
+ mg->mg_private = SIG_WIZ;
 #if MGf_COPY
  if (w->cb_copy)
   mg->mg_flags |= MGf_COPY;
@@ -529,17 +541,16 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) {
 
  for (prevmagic = NULL, mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
   moremagic = mg->mg_moremagic;
-  if (mg->mg_type == PERL_MAGIC_ext) {
-   if (mg->mg_private == sig) {
+  if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
+   MGWIZ *w = SV2MGWIZ(mg->mg_ptr);
+   if (w->sig == sig) {
 #if VMG_UVAR
     /* If the current has no uvar, short-circuit uvar deletion. */
-    uvars = (SV2MGWIZ(mg->mg_ptr)->uvar) ? (uvars + 1) : 0;
+    uvars = w->uvar ? (uvars + 1) : 0;
 #endif /* VMG_UVAR */
     break;
 #if VMG_UVAR
-   } else if ((mg->mg_private >= SIG_MIN) &&
-              (mg->mg_private <= SIG_MAX) &&
-               SV2MGWIZ(mg->mg_ptr)->uvar) {
+   } else if (w->uvar) {
     ++uvars;
     /* We can't break here since we need to find the ext magic to delete. */
 #endif /* VMG_UVAR */
@@ -564,12 +575,12 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) {
   /* mg was the first ext magic in the chain that had uvar */
 
   for (mg = moremagic; mg; mg = mg->mg_moremagic) {
-   if ((mg->mg_type == PERL_MAGIC_ext) &&
-       (mg->mg_private >= SIG_MIN) &&
-       (mg->mg_private <= SIG_MAX) &&
-        SV2MGWIZ(mg->mg_ptr)->uvar) {
-    ++uvars;
-    break;
+   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
+    MGWIZ *w = SV2MGWIZ(mg->mg_ptr);
+    if (w->uvar) {
+     ++uvars;
+     break;
+    }
    }
   }
 
@@ -914,7 +925,7 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
    default:
     continue;
   }
-  if (mg->mg_private < SIG_MIN || mg->mg_private > SIG_MAX) continue;
+  if (mg->mg_private != SIG_WIZ) continue;
   w = SV2MGWIZ(mg->mg_ptr);
   switch (w->uvar) {
    case 0:
@@ -1046,19 +1057,20 @@ STATIC const char vmg_globstorefail[]  = "Couldn't store global wizard informati
 
 STATIC U16 vmg_sv2sig(pTHX_ SV *sv) {
 #define vmg_sv2sig(S) vmg_sv2sig(aTHX_ (S))
- U16 sig;
+ IV sig;
 
  if (SvIOK(sv)) {
-  sig = SvUVX(sv);
+  sig = SvIVX(sv);
  } else if (SvNOK(sv)) {
   sig = SvNVX(sv);
  } else if ((SvPOK(sv) && grok_number(SvPVX(sv), SvCUR(sv), NULL))) {
-  sig = SvUV(sv);
+  sig = SvIV(sv);
  } else {
   croak(vmg_invalid_sig);
  }
- if (sig < SIG_MIN) { sig += SIG_MIN; }
- if (sig > SIG_MAX) { sig %= SIG_MAX + 1; }
+
+ if (sig < SIG_MIN || sig > SIG_MAX)
+  croak(vmg_invalid_sig);
 
  return sig;
 }
@@ -1079,8 +1091,9 @@ STATIC U16 vmg_wizard_sig(pTHX_ SV *wiz) {
  {
   dMY_CXT;
   if (!hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0))
-   sig = 0;
+   croak(vmg_invalid_wiz);
  }
+
  return sig;
 }
 
@@ -1233,7 +1246,7 @@ CODE:
    w  = vmg_wizard_clone(w);
    sv = MGWIZ2SV(w);
    mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0);
-   mg->mg_private = SIG_WIZ;
+   mg->mg_private = SIG_WZO;
    SvREADONLY_on(sv);
    if (!hv_store(hv, sig, len, sv, HeHASH(key))) croak("%s during CLONE", vmg_globstorefail);
   }
@@ -1340,7 +1353,7 @@ CODE:
 
  sv = MGWIZ2SV(w);
  mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0);
- mg->mg_private = SIG_WIZ;
+ mg->mg_private = SIG_WZO;
  SvREADONLY_on(sv);
 
  if (!hv_store(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), sv, 0)) croak(vmg_globstorefail);
@@ -1398,9 +1411,7 @@ PREINIT:
  SV *data;
  U16 sig;
 PPCODE:
- sig = vmg_wizard_sig(wiz);
- if (!sig)
-  XSRETURN_UNDEF;
+ sig  = vmg_wizard_sig(wiz);
  data = vmg_data_get(SvRV(sv), sig);
  if (!data) { XSRETURN_UNDEF; }
  ST(0) = data;
@@ -1412,8 +1423,6 @@ PREINIT:
  U16 sig;
 CODE:
  sig = vmg_wizard_sig(wiz);
- if (!sig)
-  XSRETURN_UNDEF;
  RETVAL = newSVuv(vmg_dispell(SvRV(sv), sig));
 OUTPUT:
  RETVAL
diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index ea15f0a..0ddcaec 100644
--- a/lib/Variable/Magic.pm
+++ b/lib/Variable/Magic.pm
@@ -193,6 +193,7 @@ This last one triggers when a key is deleted in the hash, regardless of whether
 You can refer to the tests to have more insight of where the different magics are invoked.
 
 To prevent any clash between different magics defined with this module, an unique numerical signature is attached to each kind of magic (i.e. each set of callbacks for magic operations).
+At the C level, magic tokens owned by magic created by this module have their C<< mg->mg_private >> field set to C<0x3891> or C<0x3892>, so please don't use these magic (sic) numbers in other extensions.
 
 =head1 FUNCTIONS
 
diff --git a/t/10-simple.t b/t/10-simple.t
index adfea12..0b17fde 100644
--- a/t/10-simple.t
+++ b/t/10-simple.t
@@ -45,7 +45,7 @@ is($@, '', 're-cast doesn\'t croak');
 ok($res,   're-cast is valid');
 
 $res = eval { dispell $a, gensig };
-is($@, '',      're-dispell from wrong sig doesn\'t croak');
+like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 're-dispell from wrong sig croaks');
 is($res, undef, 're-dispell from wrong sig doesn\'t return anything');
 
 $res = eval { dispell $a, undef };
diff --git a/t/13-data.t b/t/13-data.t
index 94e73e5..a67b79c 100644
--- a/t/13-data.t
+++ b/t/13-data.t
@@ -50,7 +50,7 @@ is($c,           40, 'set magic : pass data');
 is($data->{bar}, 40, 'set magic : pass data');
 
 $data = eval { getdata $a, ($sig + 1) };
-is($@, '',       'getdata from invalid sig doesn\'t croak');
+like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from invalid sig croaks');
 is($data, undef, 'getdata from invalid sig returns undef');
 
 $data = eval { getdata $a, undef };