From: Vincent Pit <vince@profvince.com>
Date: Sun, 29 Jun 2008 16:24:42 +0000 (+0200)
Subject: Importing Variable-Magic-0.10.tar.gz
X-Git-Tag: v0.10^0
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=fee1a480bc5d827590dc7394e0a77741bad86dc3

Importing Variable-Magic-0.10.tar.gz
---

diff --git a/Changes b/Changes
index d60708c..0d52bc6 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,16 @@
 Revision history for Variable-Magic
 
+0.10    2008-02-04 11:30 UTC
+        + Add : New script : samples/vm_vs_tie.pl, that benchmarks our uvar
+                magic versus tied hashes.
+        + Add : The VMG_COMPAT_* constants can be used from userspace to check
+                perl magic abilities.
+        + Fix : Callbacks that returned undef made us croak, breaking the
+                variable behaviour (regression test in 14-callbacks.t).
+        + Fix : uvar callbacks weren't tested for non-NULL-ity before being
+                called (regression test in 28-uvar.t).
+        + Tst : Fix typo in 25-copy.t that prevented Tie::Hash tests to be ran.
+
 0.09    2008-02-02 11:30 UTC
         + Doc : Explicitely say that uvar callbacks are safely ignored for
                 non-hashes.
diff --git a/MANIFEST b/MANIFEST
index a29ee25..92e00d6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,14 +7,16 @@ README
 lib/Variable/Magic.pm
 samples/magic.pl
 samples/uvar.pl
+samples/vm_vs_tie.pl
 t/00-load.t
 t/01-import.t
 t/10-simple.t
 t/11-multiple.t
-t/12-data.t
-t/13-sig.t
-t/14-self.t
-t/15-huf.t
+t/12-sig.t
+t/13-data.t
+t/14-callbacks.t
+t/15-self.t
+t/16-huf.t
 t/20-get.t
 t/21-set.t
 t/22-len.t
diff --git a/META.yml b/META.yml
index a02573d..799f882 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Variable-Magic
-version:             0.09
+version:             0.10
 abstract:            Associate user-defined magic to variables from Perl.
 license:             perl
 author:              
diff --git a/Magic.xs b/Magic.xs
index c81db04..2df5bb4 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -12,10 +12,14 @@
 
 #define R(S) fprintf(stderr, "R(" #S ") = %d\n", SvREFCNT(S))
 
+#define PERL_VERSION_GE(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+
 #define PERL_VERSION_LE(R, V, S) (PERL_REVISION < (R) || (PERL_REVISION == (R) && (PERL_VERSION < (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION <= (S))))))
 
 #define PERL_API_VERSION_GE(R, V, S) (PERL_API_REVISION > (R) || (PERL_API_REVISION == (R) && (PERL_API_VERSION > (V) || (PERL_API_VERSION == (V) && (PERL_API_SUBVERSION >= (S))))))
 
+#define PERL_API_VERSION_LE(R, V, S) (PERL_API_REVISION < (R) || (PERL_API_REVISION == (R) && (PERL_API_VERSION < (V) || (PERL_API_VERSION == (V) && (PERL_API_SUBVERSION <= (S))))))
+
 /* --- Compatibility ------------------------------------------------------- */
 
 #ifndef Newx
@@ -56,6 +60,25 @@
 # define VMG_UVAR 0
 #endif
 
+#if PERL_VERSION_GE(5, 9, 3)
+# define VMG_COMPAT_ARRAY_PUSH_NOLEN 1
+#else
+# define VMG_COMPAT_ARRAY_PUSH_NOLEN 0
+#endif
+
+/* since 5.9.5 - see #43357 */
+#if PERL_VERSION_GE(5, 9, 5)
+# define VMG_COMPAT_ARRAY_UNDEF_CLEAR 1
+#else
+# define VMG_COMPAT_ARRAY_UNDEF_CLEAR 0
+#endif
+
+#if MGf_COPY && PERL_VERSION_GE(5, 9, 4)
+# define VMG_COMPAT_HASH_LISTASSIGN_COPY 1
+#else
+# define VMG_COMPAT_HASH_LISTASSIGN_COPY 0
+#endif
+
 #if VMG_UVAR
 
 /* Bug-free mg_magical - see http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html */
@@ -97,9 +120,9 @@ START_MY_CXT
 /* --- Signatures ---------------------------------------------------------- */
 
 #define SIG_MIN ((U16) (1u << 8))
-#define SIG_MAX ((U16) (1u << 16 - 1))
+#define SIG_MAX ((U16) ((1u << 16) - 1))
 #define SIG_NBR (SIG_MAX - SIG_MIN + 1)
-#define SIG_WIZ ((U16) (1u << 8 - 1))
+#define SIG_WIZ ((U16) ((1u << 8) - 1))
 
 /* ... Generate signatures ................................................. */
 
@@ -183,7 +206,6 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
 
 STATIC SV *vmg_data_get(SV *sv, U16 sig) {
  MAGIC *mg, *moremagic;
- MGWIZ *w;
 
  if (SvTYPE(sv) >= SVt_PVMG) {
   for (mg = SvMAGIC(sv); mg; mg = moremagic) {
@@ -368,6 +390,7 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) {
 
 STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data) {
 #define vmg_cb_call(I, S, D) vmg_cb_call(aTHX_ (I), (S), (D))
+ SV *svr;
  int ret;
 
  dSP;
@@ -386,7 +409,8 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data) {
  SPAGAIN;
 
  if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
- ret = POPi;
+ svr = POPs;
+ ret = SvOK(svr) ? SvIV(svr) : 0;
 
  PUTBACK;
 
@@ -399,6 +423,7 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data) {
 #if MGf_COPY || VMG_UVAR
 STATIC int vmg_cb_call2(pTHX_ SV *cb, SV *sv, SV *data, SV *sv2) {
 #define vmg_cb_call2(I, S, D, S2) vmg_cb_call2(aTHX_ (I), (S), (D), (S2))
+ SV *svr;
  int ret;
 
  dSP;
@@ -418,7 +443,8 @@ STATIC int vmg_cb_call2(pTHX_ SV *cb, SV *sv, SV *data, SV *sv2) {
  SPAGAIN;
 
  if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
- ret = POPi;
+ svr = POPs;
+ ret = SvOK(svr) ? SvIV(svr) : 0;
 
  PUTBACK;
 
@@ -438,6 +464,8 @@ STATIC int vmg_svt_set(pTHX_ SV *sv, MAGIC *mg) {
 }
 
 STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
+ SV *svr;
+ I32 len;
  U32 ret;
 
  dSP;
@@ -450,7 +478,8 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  XPUSHs(sv_2mortal(newRV_inc(sv)));
  XPUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
  if (SvTYPE(sv) == SVt_PVAV) {
-  XPUSHs(sv_2mortal(newSViv(av_len((AV *) sv) + 1)));
+  len = av_len((AV *) sv) + 1;
+  XPUSHs(sv_2mortal(newSViv(len)));
  }
  PUTBACK;
 
@@ -459,7 +488,9 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  SPAGAIN;
 
  if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
- ret = POPi;
+ svr = POPs;
+ ret = SvOK(svr) ? SvUV(svr)
+                 : ((SvTYPE(sv) == SVt_PVAV) ? len : 1);
 
  PUTBACK;
 
@@ -520,20 +551,21 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
    || (mg->mg_private < SIG_MIN)
    || (mg->mg_private > SIG_MAX)) { continue; }
   w = SV2MGWIZ(mg->mg_ptr);
+  if (!w->uvar) { continue; }
   switch (action) {
    case 0:
-    vmg_cb_call2(w->cb_fetch, sv, mg->mg_obj, key);
+    if (w->cb_fetch) { vmg_cb_call2(w->cb_fetch, sv, mg->mg_obj, key); }
     break;
    case HV_FETCH_ISSTORE:
    case HV_FETCH_LVALUE:
    case (HV_FETCH_ISSTORE|HV_FETCH_LVALUE):
-    vmg_cb_call2(w->cb_store, sv, mg->mg_obj, key);
+    if (w->cb_store) { vmg_cb_call2(w->cb_store, sv, mg->mg_obj, key); }
     break;
    case HV_FETCH_ISEXISTS:
-    vmg_cb_call2(w->cb_exists, sv, mg->mg_obj, key);
+    if (w->cb_exists) { vmg_cb_call2(w->cb_exists, sv, mg->mg_obj, key); }
     break;
    case HV_DELETE:
-    vmg_cb_call2(w->cb_delete, sv, mg->mg_obj, key);
+    if (w->cb_delete) { vmg_cb_call2(w->cb_delete, sv, mg->mg_obj, key); }
     break;
   }
  }
@@ -570,10 +602,10 @@ STATIC int vmg_wizard_free(pTHX_ SV *wiz, MAGIC *mg) {
 #endif /* MGf_COPY */
 #if MGf_DUP
  if (w->cb_dup   != NULL) { SvREFCNT_dec(SvRV(w->cb_dup)); }
-#endif /* MGf_COPY */
+#endif /* MGf_DUP */
 #if MGf_LOCAL
  if (w->cb_local != NULL) { SvREFCNT_dec(SvRV(w->cb_local)); }
-#endif /* MGf_COPY */
+#endif /* MGf_LOCAL */
 #if VMG_UVAR
  if (w->cb_fetch  != NULL) { SvREFCNT_dec(SvRV(w->cb_fetch)); }
  if (w->cb_store  != NULL) { SvREFCNT_dec(SvRV(w->cb_store)); }
@@ -600,7 +632,7 @@ STATIC MGVTBL vmg_wizard_vtbl = {
 #endif /* MGf_DUP */
 #if MGf_LOCAL
  NULL,            /* local */
-#endif /* MGf_DUP */
+#endif /* MGf_LOCAL */
 };
 
 STATIC const char vmg_invalid_wiz[]    = "Invalid wizard object";
@@ -664,6 +696,12 @@ 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_ARRAY_PUSH_NOLEN",
+                    newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN));
+ newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNDEF_CLEAR",
+                    newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR));
+ newCONSTSUB(stash, "VMG_COMPAT_HASH_LISTASSIGN_COPY",
+                    newSVuv(VMG_COMPAT_HASH_LISTASSIGN_COPY));
 }
 
 SV *_wizard(...)
@@ -700,7 +738,7 @@ CODE:
  if (SvOK(svsig)) {
   SV **old;
   sig = vmg_sv2sig(svsig);
-  if (old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0)) {
+  if ((old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))) {
    ST(0) = sv_2mortal(newRV_inc(*old));
    XSRETURN(1);
   }
@@ -781,7 +819,7 @@ CODE:
   char buf[8];
   SV **old;
   U16 sig = vmg_sv2sig(wiz);
-  if (old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0)) {
+  if ((old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))) {
    wiz = *old;
   } else {
    XSRETURN_UNDEF;
diff --git a/README b/README
index 5ca2936..c947b23 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     Variable::Magic - Associate user-defined magic to variables from Perl.
 
 VERSION
-    Version 0.09
+    Version 0.10
 
 SYNOPSIS
         use Variable::Magic qw/wizard cast dispell/;
@@ -127,6 +127,17 @@ CONSTANTS
     When this constant is true, you can use the "fetch,store,exists,delete"
     callbacks on hashes.
 
+  "VMG_COMPAT_ARRAY_PUSH_NOLEN"
+    True for perls that don't call 'len' magic when you push an element in a
+    magical array.
+
+  "VMG_COMPAT_ARRAY_UNDEF_CLEAR"
+    True for perls that call 'clear' magic when undefining magical arrays.
+
+  "VMG_COMPAT_HASH_LISTASSIGN_COPY"
+    True for perls that call 'copy' magic on list assignments. Implies that
+    "MGf_COPY" is true.
+
 FUNCTIONS
   "wizard"
         wizard sig    => ...,
diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index 0ac5b52..8025a40 100644
--- a/lib/Variable/Magic.pm
+++ b/lib/Variable/Magic.pm
@@ -13,13 +13,13 @@ Variable::Magic - Associate user-defined magic to variables from Perl.
 
 =head1 VERSION
 
-Version 0.09
+Version 0.10
 
 =cut
 
 our $VERSION;
 BEGIN {
- $VERSION = '0.09';
+ $VERSION = '0.10';
 }
 
 =head1 SYNOPSIS
@@ -163,6 +163,18 @@ Evaluates to true iff the 'local' magic is available.
 
 When this constant is true, you can use the C<fetch,store,exists,delete> callbacks on hashes.
 
+=head2 C<VMG_COMPAT_ARRAY_PUSH_NOLEN>
+
+True for perls that don't call 'len' magic when you push an element in a magical array.
+
+=head2 C<VMG_COMPAT_ARRAY_UNDEF_CLEAR>
+
+True for perls that call 'clear' magic when undefining magical arrays.
+
+=head2 C<VMG_COMPAT_HASH_LISTASSIGN_COPY>
+
+True for perls that call 'copy' magic on list assignments. Implies that C<MGf_COPY> is true.
+
 =head1 FUNCTIONS
 
 =cut
@@ -281,7 +293,8 @@ use base qw/Exporter/;
 our @EXPORT         = ();
 our %EXPORT_TAGS    = (
  'funcs' =>  [ qw/wizard gensig getsig cast getdata dispell/ ],
- 'consts' => [ qw/SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/ ]
+ 'consts' => [ qw/SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/,
+               qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR VMG_COMPAT_HASH_LISTASSIGN_COPY/ ]
 );
 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
diff --git a/samples/magic.pl b/samples/magic.pl
index 7411744..3c14d49 100755
--- a/samples/magic.pl
+++ b/samples/magic.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
 
 use strict;
 use warnings;
diff --git a/samples/uvar.pl b/samples/uvar.pl
index 3a968ec..738a5db 100755
--- a/samples/uvar.pl
+++ b/samples/uvar.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
 
 use strict;
 use warnings;
diff --git a/samples/vm_vs_tie.pl b/samples/vm_vs_tie.pl
new file mode 100755
index 0000000..9c8cae4
--- /dev/null
+++ b/samples/vm_vs_tie.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Tie::Hash;
+
+use lib qw{blib/arch blib/lib};
+use Variable::Magic qw/wizard cast VMG_UVAR/;
+
+use Benchmark qw/cmpthese/;
+
+die 'Your perl does not support the nice uvar magic of 5.10.*' unless VMG_UVAR;
+
+my @a = ('a' .. 'z');
+
+tie my %t, 'Tie::StdHash';
+$t{$a[$_]} = $_ for 0 .. $#a;
+
+my $wiz = wizard fetch => sub { 0 }, store => sub { 0 };
+my %v;
+$v{$a[$_]} = $_ for 0 .. $#a;
+cast %v, $wiz;
+
+cmpthese -3, {
+ 'tie'  => sub { my ($x, $y) = map @a[rand @a], 1 .. 2; my $a = $t{$x}; $t{$y} = $a },
+ 'v::m' => sub { my ($x, $y) = map @a[rand @a], 1 .. 2; my $a = $v{$x}; $v{$y} = $a }
+};
diff --git a/t/12-sig.t b/t/12-sig.t
new file mode 100644
index 0000000..6564d36
--- /dev/null
+++ b/t/12-sig.t
@@ -0,0 +1,60 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 24;
+
+use Variable::Magic qw/wizard getsig cast dispell SIG_MIN/;
+
+my $sig = 300;
+
+my ($a, $b, $c, $d) = 1 .. 4;
+
+{
+ my $wiz = eval { wizard sig => $sig };
+ ok(!$@, "wizard creation error ($@)");
+ ok(defined $wiz, 'wizard is defined');
+ ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
+ ok($sig == getsig $wiz, 'wizard signature is correct');
+
+ my $wiz2 = eval { wizard sig => $sig };
+ ok(!$@, "wizard retrieve error ($@)");
+ ok(defined $wiz2, 'retrieved wizard is defined');
+ ok(ref $wiz2 eq 'SCALAR', 'retrieved wizard is a scalar ref');
+ ok($sig == getsig $wiz2, 'retrieved wizard signature is correct');
+
+ my $a = 1;
+ my $res = eval { cast $a, $wiz };
+ ok(!$@, "cast from wizard croaks ($@)");
+ ok($res, 'cast from wizard invalid');
+
+ $res = eval { dispell $a, $wiz2 };
+ ok(!$@, "dispell from retrieved wizard croaks ($@)");
+ ok($res, 'dispell from retrieved wizard invalid');
+
+ $res = eval { cast $b, $sig };
+ ok(!$@, "cast from integer croaks ($@)");
+ ok($res, 'cast from integer invalid');
+}
+
+my $res = eval { cast $c, $sig + 0.1 };
+ok(!$@, "cast from float croaks ($@)");
+ok($res, 'cast from float invalid');
+
+$res = eval { cast $d, sprintf "%u", $sig };
+ok(!$@, "cast from string croaks ($@)");
+ok($res, 'cast from string invalid');
+
+$res = eval { dispell $b, $sig };
+ok(!$@, "dispell from integer croaks ($@)");
+ok($res, 'dispell from integer invalid');
+
+$res = eval { dispell $c, $sig + 0.1 };
+ok(!$@, "dispell from float croaks ($@)");
+ok($res, 'dispell from float invalid');
+
+$res = eval { dispell $d, sprintf "%u", $sig };
+ok(!$@, "dispell from string croaks ($@)");
+ok($res, 'dispell from string invalid');
+
diff --git a/t/13-data.t b/t/13-data.t
new file mode 100644
index 0000000..1e8b9eb
--- /dev/null
+++ b/t/13-data.t
@@ -0,0 +1,56 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 19;
+
+use Variable::Magic qw/wizard getdata cast dispell/;
+
+my $c = 1;
+
+my $wiz = eval {
+ wizard data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } },
+         get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
+         set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
+};
+ok(!$@, "wizard creation error ($@)");
+ok(defined $wiz, 'wizard is defined');
+ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
+
+my $a = 75;
+my $res = eval { cast $a, $wiz };
+ok(!$@, "cast croaks ($@)");
+ok($res, 'cast invalid');
+
+my $data = eval { getdata $a, $wiz };
+ok(!$@, "getdata croaks ($@)");
+ok($res, 'getdata invalid');
+ok($data && ref($data) eq 'HASH'
+         && exists $data->{foo} && $data->{foo} == 12
+         && exists $data->{bar} && $data->{bar} == 27,
+   'private data creation ok');
+
+my $b = $a;
+ok($c == 13, 'get magic : pass data');
+ok($data->{foo} == 13, 'get magic : data updated');
+
+$a = 57;
+ok($c == 40, 'set magic : pass data');
+ok($data->{bar} == 40, 'set magic : pass data');
+
+$res = eval { dispell $a, $wiz };
+ok(!$@, "dispell croaks ($@)");
+ok($res, 'dispell invalid');
+
+$res = eval { cast $a, $wiz, qw/z j t/ };
+ok(!$@, "cast with arguments croaks ($@)");
+ok($res, 'cast with arguments invalid');
+
+$data = eval { getdata $a, $wiz };
+ok(!$@, "getdata croaks ($@)");
+ok($res, 'getdata invalid');
+ok($data && ref($data) eq 'HASH'
+         && exists $data->{foo} && $data->{foo} eq 'z'
+         && exists $data->{bar} && $data->{bar} eq 't',
+   'private data creation with arguments ok');
diff --git a/t/14-callbacks.t b/t/14-callbacks.t
new file mode 100644
index 0000000..a34549a
--- /dev/null
+++ b/t/14-callbacks.t
@@ -0,0 +1,28 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use Variable::Magic qw/wizard cast/;
+
+my $wiz = eval { wizard get => sub { undef } };
+ok(!$@, "wizard creation error ($@)");
+ok(defined $wiz, 'wizard is defined');
+ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
+
+my $n = int rand 1000;
+my $a = $n;
+
+my $res = eval { cast $a, $wiz };
+ok(!$@, "cast croaks ($@)");
+ok($res, 'cast invalid');
+
+my $x;
+eval {
+ local $SIG{__WARN__} = sub { die };
+ $x = $a
+};
+ok(!$@, 'callback returning undef croaks');
+ok(defined($x) && ($x == $n), 'callback returning undef fails');
diff --git a/t/15-self.t b/t/15-self.t
new file mode 100644
index 0000000..6f6d9a4
--- /dev/null
+++ b/t/15-self.t
@@ -0,0 +1,53 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+
+use Variable::Magic qw/wizard cast dispell getdata getsig/;
+
+my $c = 0;
+
+{
+ my $wiz = eval {
+  wizard data => sub { $_[0] },
+         get  => sub { ++$c },
+         free => sub { --$c }
+ };
+ ok(!$@, "wizard creation error ($@)");
+ ok(defined $wiz, 'wizard is defined');
+ ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
+
+ my $res = eval { cast $wiz, $wiz };
+ ok(!$@, "cast on self croaks ($@)");
+ ok($res, 'cast on self invalid');
+
+ my $w = $wiz;
+ ok($c == 1, 'magic works correctly on self');
+
+ $res = eval { dispell $wiz, $wiz };
+ ok(!$@, "dispell on self croaks ($@)");
+ ok($res, 'dispell on self invalid');
+
+ $w = $wiz;
+ ok($c == 1, 'magic is no longer invoked on self when dispelled');
+
+ $res = eval { cast $wiz, $wiz, $wiz };
+ ok(!$@, "re-cast on self croaks ($@)");
+ ok($res, 're-cast on self invalid');
+
+ $w = getdata $wiz, $wiz;
+ ok($c == 1, 'getdata on magical self doesn\'t trigger callbacks');
+ # ok(getsig($w) == getsig($wiz), 'getdata returns the correct wizard');
+
+ $res = eval { dispell $wiz, $wiz };
+ ok(!$@, "re-dispell on self croaks ($@)");
+ ok($res, 're-dispell on self invalid');
+
+ $res = eval { cast $wiz, $wiz };
+ ok(!$@, "re-re-cast on self croaks ($@)");
+ ok($res, 're-re-cast on self invalid');
+}
+
+# ok($c == 0, 'magic destructor is called');
diff --git a/t/16-huf.t b/t/16-huf.t
new file mode 100644
index 0000000..7d28277
--- /dev/null
+++ b/t/16-huf.t
@@ -0,0 +1,51 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Variable::Magic qw/wizard cast dispell VMG_UVAR/;
+
+if (!VMG_UVAR) {
+ plan skip_all => 'No nice uvar magic for this perl';
+}
+
+eval "use Hash::Util::FieldHash qw/fieldhash/";
+if ($@) {
+ plan skip_all => 'Hash::Util::FieldHash required for testing uvar interaction';
+} else {
+ plan tests => 12;
+}
+
+fieldhash(my %h);
+
+bless \(my $obj = {}), 'Variable::Magic::Test::Mock';
+$h{$obj} = 5;
+
+my ($w, $c) = (undef, 0);
+
+eval { $w = wizard fetch => sub { ++$c }, store => sub { --$c } };
+ok(!$@, "wizard with uvar creation error ($@)");
+ok(defined $w, 'wizard with uvar is defined');
+ok(ref($w) eq 'SCALAR', 'wizard with uvar is a scalar ref');
+
+my $res = eval { cast %h, $w };
+ok(!$@, "cast uvar magic on fieldhash croaks ($@)");
+ok($res, 'cast uvar magic on fieldhash invalid');
+
+my $s = $h{$obj};
+ok($s == 5, 'fetch magic on fieldhash doesn\'t clobber');
+ok($c == 1, 'fetch magic on fieldhash');
+
+$h{$obj} = 7;
+ok($c == 0, 'store magic on fieldhash');
+ok($h{$obj} == 7, 'store magic on fieldhash doesn\'t clobber'); # $c == 1
+
+$res = eval { dispell %h, $w };
+ok(!$@, "dispell uvar magic on fieldhash croaks ($@)");
+ok($res, 'dispell uvar magic on fieldhash invalid');
+
+$h{$obj} = 11;
+$s = $h{$obj};
+ok($s == 11, 'store/fetch on fieldhash after dispell still ok');
diff --git a/t/25-copy.t b/t/25-copy.t
index 8548db0..3a033a3 100644
--- a/t/25-copy.t
+++ b/t/25-copy.t
@@ -44,7 +44,7 @@ SKIP: {
 }
 
 SKIP: {
- eval "use Tie::Has";
+ eval "use Tie::Hash";
  skip 'Tie::Hash required to test copy magic on hashes', 14 if $@;
 
  tie my %h, 'Tie::StdHash';
diff --git a/t/28-uvar.t b/t/28-uvar.t
index b6c8959..364c7cd 100644
--- a/t/28-uvar.t
+++ b/t/28-uvar.t
@@ -8,7 +8,7 @@ use Test::More;
 use Variable::Magic qw/wizard cast dispell VMG_UVAR/;
 
 if (VMG_UVAR) {
- plan tests => 16;
+ plan tests => 20;
 } else {
  plan skip_all => 'No nice uvar magic for this perl';
 }
@@ -29,7 +29,6 @@ ok(check(), 'uvar : create wizard');
 
 my %h = (a => 1, b => 2, c => 3);
 my $res = cast %h, $wiz;
-
 ok($res,    'uvar : cast succeeded');
 ok(check(), 'uvar : cast didn\'t triggered the callback');
 
@@ -67,3 +66,20 @@ $x = delete $h{z};
 ok(check(),     'uvar : delete non-existing key');
 ok(!defined $x, 'uvar : delete non-existing key correctly');
 
+my $wiz2 = wizard 'fetch'  => sub { 0 };
+my %h2 = (a => 37, b => 2, c => 3);
+cast %h2, $wiz2;
+
+eval {
+ local $SIG{__WARN__} = sub { die };
+ $x = $h2{a};
+};
+ok(!$@,      'uvar : fetch with incomplete magic');
+ok($x == 37, 'uvar : fetch with incomplete magic correctly');
+
+eval {
+ local $SIG{__WARN__} = sub { die };
+ $h2{a} = 73;
+};
+ok(!$@,         'uvar : store with incomplete magic');
+ok($h2{a} == 73, 'uvar : store with incomplete magic correctly');
diff --git a/t/31-array.t b/t/31-array.t
index a7496a9..2fee830 100644
--- a/t/31-array.t
+++ b/t/31-array.t
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 21;
 
-use Variable::Magic qw/wizard cast dispell/;
+use Variable::Magic qw/wizard cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR/;
 
 my @c = (0) x 12;
 my @x = (0) x 12;
@@ -64,7 +64,7 @@ $a[3] = 'd';
 ok(check(), 'array : assign new element');
 
 push @a, 'x';
-++$x[1]; ++$x[2] unless $^V && $^V gt 5.9.2; # since 5.9.3
+++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_PUSH_NOLEN;
 ok(check(), 'array : push');
 
 pop @a;
@@ -103,7 +103,7 @@ ok(check(), 'array : for');
 ok(check(), 'array : scope end');
 
 undef @a;
-++$x[3] if $^V && $^V gt 5.9.4; # since 5.9.5 - see #43357
+++$x[3] if VMG_COMPAT_ARRAY_UNDEF_CLEAR;
 ok(check(), 'array : undef');
 
 dispell @a, $wiz;
diff --git a/t/32-hash.t b/t/32-hash.t
index 54c23d8..7f1669a 100644
--- a/t/32-hash.t
+++ b/t/32-hash.t
@@ -3,9 +3,9 @@
 use strict;
 use warnings;
 
-use Test::More tests => 17;
+use Test::More tests => 18;
 
-use Variable::Magic qw/wizard cast dispell MGf_COPY VMG_UVAR/;
+use Variable::Magic qw/wizard cast dispell MGf_COPY VMG_UVAR VMG_COMPAT_HASH_LISTASSIGN_COPY/;
 
 my @c = (0) x 12;
 my @x = (0) x 12;
@@ -54,11 +54,17 @@ $x[5] += 2 if MGf_COPY;
 $x[8] += 2 if VMG_UVAR;
 ok(check(), 'hash : slice');
 
+%a = (a => 1, d => 3);
+++$x[3];
+$x[5] += 2 if VMG_COMPAT_HASH_LISTASSIGN_COPY;
+$x[9] += 2 if VMG_UVAR;
+ok(check(), 'hash : assign from list');
+
 %a = map { $_ => 1 } qw/a b d/;
 ++$x[3];
-$x[5] += 3 if MGf_COPY && $^V && $^V gt 5.9.3;
+$x[5] += 3 if VMG_COMPAT_HASH_LISTASSIGN_COPY;
 $x[9] += 3 if VMG_UVAR;
-ok(check(), 'hash : assign');
+ok(check(), 'hash : assign from map');
 
 $a{d} = 2;
 ++$x[5] if MGf_COPY;