From: Vincent Pit <vince@profvince.com>
Date: Sat, 20 Sep 2008 22:31:58 +0000 (+0200)
Subject: Factor signature/wizard checks into proper functions. 'cast , undef' now throws an... 
X-Git-Tag: v0.20~5
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=b43ca6c10beabb678914eb7845fed4abda6cd852;p=perl%2Fmodules%2FVariable-Magic.git

Factor signature/wizard checks into proper functions. 'cast , undef' now throws an 'invalid wizard' error
---

diff --git a/Magic.xs b/Magic.xs
index ce1c4b3..b62d5f7 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -713,6 +713,52 @@ STATIC U16 vmg_sv2sig(pTHX_ SV *sv) {
  return sig;
 }
 
+STATIC U16 vmg_wizard_sig(pTHX_ SV *wiz) {
+#define vmg_wizard_sig(W) vmg_wizard_sig(aTHX_ (W))
+ char buf[8];
+ U16 sig;
+
+ if (SvROK(wiz)) {
+  sig = SV2MGWIZ(SvRV(wiz))->sig;
+ } else if (SvOK(wiz)) {
+  sig = vmg_sv2sig(wiz);
+ } else {
+  croak(vmg_invalid_wiz);
+ }
+
+ dMY_CXT;
+
+ if (!hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))
+  sig = 0;
+
+ return sig;
+}
+
+STATIC SV *vmg_wizard_wiz(pTHX_ SV *wiz) {
+#define vmg_wizard_wiz(W) vmg_wizard_wiz(aTHX_ (W))
+ char buf[8];
+ SV **old;
+ U16 sig;
+
+ if (SvROK(wiz)) {
+  wiz = SvRV(wiz);
+#if VMG_MULTIPLICITY
+  if (SV2MGWIZ(wiz)->owner == aTHX)
+   return wiz;
+#endif /* VMG_MULTIPLICITY */
+  sig = SV2MGWIZ(wiz)->sig;
+ } else if (SvOK(wiz)) {
+  sig = vmg_sv2sig(wiz);
+ } else {
+  croak(vmg_invalid_wiz);
+ }
+
+ dMY_CXT;
+
+ return (old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))
+         ? *old : NULL;
+}
+
 #define VMG_SET_CB(S, N)              \
  cb = (S);                            \
  w->cb_ ## N = (SvOK(cb) && SvROK(cb)) ? newRV_inc(SvRV(cb)) : NULL;
@@ -964,21 +1010,9 @@ PREINIT:
  AV *args = NULL;
  SV *ret;
 CODE:
- dMY_CXT;
- if (SvROK(wiz)) {
-  wiz = SvRV(wiz);
- } else if (SvOK(wiz)) {
-  char buf[8];
-  SV **old;
-  U16 sig = vmg_sv2sig(wiz);
-  if ((old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))) {
-   wiz = *old;
-  } else {
-   XSRETURN_UNDEF;
-  }
- } else {
-  croak(vmg_invalid_sig);
- }
+ wiz = vmg_wizard_wiz(wiz);
+ if (!wiz)
+  XSRETURN_UNDEF;
  if (items > 2) {
   I32 i;
   args = newAV();
@@ -1001,18 +1035,9 @@ PREINIT:
  SV *data;
  U16 sig;
 CODE:
- dMY_CXT;
- if (SvROK(wiz)) {
-  sig = SV2MGWIZ(SvRV(wiz))->sig;
- } else if (SvOK(wiz)) {
-  char buf[8];
-  sig = vmg_sv2sig(wiz);
-  if (!hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0)) {
-   XSRETURN_UNDEF;
-  }
- } else {
-  croak(vmg_invalid_wiz);
- }
+ sig = vmg_wizard_sig(wiz);
+ if (!sig)
+  XSRETURN_UNDEF;
  data = vmg_data_get(SvRV(sv), sig);
  if (!data) { XSRETURN_UNDEF; }
  ST(0) = data;
@@ -1023,18 +1048,9 @@ PROTOTYPE: \[$@%&*]$
 PREINIT:
  U16 sig;
 CODE:
- dMY_CXT;
- if (SvROK(wiz)) {
-  sig = SV2MGWIZ(SvRV(wiz))->sig;
- } else if (SvOK(wiz)) {
-  char buf[8];
-  sig = vmg_sv2sig(wiz);
-  if (!hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0)) {
-   XSRETURN_UNDEF;
-  }
- } else {
-  croak(vmg_invalid_wiz);
- }
+ sig = vmg_wizard_sig(wiz);
+ if (!sig)
+  XSRETURN_UNDEF;
  RETVAL = newSVuv(vmg_dispell(SvRV(sv), sig));
 OUTPUT:
  RETVAL
diff --git a/t/10-simple.t b/t/10-simple.t
index 854cdde..7921fac 100644
--- a/t/10-simple.t
+++ b/t/10-simple.t
@@ -72,5 +72,5 @@ is($@, '',      'cast from obsolete signature doesn\'t croak');
 is($res, undef, 'cast from obsolete signature returns undef');
 
 $res = eval { cast $c, undef };
-like($@, qr/Invalid\s+numeric\s+signature\s+at\s+\Q$0\E/, 'cast from undef croaks');
+like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'cast from undef croaks');
 is($res, undef, 'cast from undef doesn\'t return anything');