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

Importing Variable-Magic-0.16.tar.gz
---

diff --git a/Changes b/Changes
index 3471bcb..659b4c4 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,13 @@
 Revision history for Variable-Magic
 
+0.16    2008-05-10 22:05 UTC
+        + Add : The samples/copy.pl script.
+        + Chg : The sv_magical() + vmg_mg_magical() combo was simplified into
+                vmg_sv_magicuvar().
+        + Tst : t/33-code.t was testing scalars, not code.
+        + Tst : is() and like() are better than ok().
+        + Tst : 100% coverage reached.
+
 0.15    2008-04-11 18:25 UTC
         + Chg : Factor vmg_cb_call{1,2,3}() into one function.
         + Fix : len magic is no longer called when taking the length() of a
diff --git a/MANIFEST b/MANIFEST
index 92e00d6..77a5fff 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5,6 +5,7 @@ Magic.xs
 Makefile.PL
 README
 lib/Variable/Magic.pm
+samples/copy.pl
 samples/magic.pl
 samples/uvar.pl
 samples/vm_vs_tie.pl
diff --git a/META.yml b/META.yml
index 54c9a64..9741746 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Variable-Magic
-version:             0.15
+version:             0.16
 abstract:            Associate user-defined magic to variables from Perl.
 license:             perl
 author:              
diff --git a/Magic.xs b/Magic.xs
index 2cd4e7c..c1e582f 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -90,26 +90,34 @@
 
 #if VMG_UVAR
 
-/* Bug-free mg_magical - see http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html */
-STATIC void vmg_mg_magical(pTHX_ SV *sv) {
-#define vmg_mg_magical(S) vmg_mg_magical(aTHX_ (S))
+/* Bug-free mg_magical - see http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html, but specialized to our needs. */
+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. */
  PERL_UNUSED_CONTEXT;
  if ((mg = SvMAGIC(sv))) {
   SvRMAGICAL_off(sv);
   do {
    const MGVTBL* const vtbl = mg->mg_virtual;
    if (vtbl) {
+/* 
     if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
      SvGMAGICAL_on(sv);
     if (vtbl->svt_set)
      SvSMAGICAL_on(sv);
-    if (vtbl->svt_clear)
+*/
+    if (vtbl->svt_clear) {
      SvRMAGICAL_on(sv);
+     break;
+    }
    }
   } while ((mg = mg->mg_moremagic));
+/*
   if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)))
    SvRMAGICAL_on(sv);
+*/
  }
 }
 
@@ -307,8 +315,7 @@ STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
   }
 
   if (add_uvar) {
-   sv_magic(sv, NULL, PERL_MAGIC_uvar, (const char *) &uf, sizeof(uf));
-   vmg_mg_magical(sv);
+   vmg_sv_magicuvar(sv, (const char *) &uf, sizeof(uf));
   }
 
  }
@@ -418,8 +425,8 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data, unsigned int args, ...) {
  PUSHs(data ? data : &PL_sv_undef);
  va_start(ap, args);
  for (i = 0; i < args; ++i) {
-  SV *sv = va_arg(ap, SV *);
-  PUSHs(sv ? sv : &PL_sv_undef);
+  SV *sva = va_arg(ap, SV *);
+  PUSHs(sva ? sva : &PL_sv_undef);
  }
  va_end(ap);
  PUTBACK;
@@ -469,8 +476,9 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
  if (SvTYPE(sv) == SVt_PVAV) {
   len = av_len((AV *) sv) + 1;
-  PUSHs(sv_2mortal(newSViv(len)));
+  mPUSHi(len);
  } else {
+  len = 1;
   PUSHs(&PL_sv_undef);
  }
  PUTBACK;
@@ -481,8 +489,7 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
 
  if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
  svr = POPs;
- ret = SvOK(svr) ? SvUV(svr)
-                 : ((SvTYPE(sv) == SVt_PVAV) ? len : 1);
+ ret = SvOK(svr) ? SvUV(svr) : len;
 
  PUTBACK;
 
diff --git a/README b/README
index 944ed19..55fe265 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     Variable::Magic - Associate user-defined magic to variables from Perl.
 
 VERSION
-    Version 0.15
+    Version 0.16
 
 SYNOPSIS
         use Variable::Magic qw/wizard cast dispell/;
diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index e14283f..0736798 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.15
+Version 0.16
 
 =cut
 
 our $VERSION;
 BEGIN {
- $VERSION = '0.15';
+ $VERSION = '0.16';
 }
 
 =head1 SYNOPSIS
diff --git a/samples/copy.pl b/samples/copy.pl
new file mode 100755
index 0000000..f716906
--- /dev/null
+++ b/samples/copy.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use lib qw{blib/arch blib/lib};
+use Variable::Magic qw/wizard getsig cast/;
+use Tie::Hash;
+
+my $wiz = wizard copy => sub { print STDERR "COPY $_[2] => $_[3]\n" },
+                 free => sub { print STDERR "FREE\n" };
+my %h;
+tie %h, 'Tie::StdHash';
+%h = (a => 1, b => 2);
+cast %h, $wiz;
+$h{b} = 3;
+my $x = delete $h{b};
+$x == 3 or die 'incorrect';
diff --git a/samples/vm_vs_tie.pl b/samples/vm_vs_tie.pl
index cfb491c..8de8ea9 100755
--- a/samples/vm_vs_tie.pl
+++ b/samples/vm_vs_tie.pl
@@ -24,6 +24,7 @@ cast %v, $wiz;
 
 my $x = 0;
 
+print "Using Variable::Magic ", $Variable::Magic::VERSION, "\n";
 cmpthese -3, {
  'tie'  => sub { my ($x, $y) = map @a[$x++ % @a], 1 .. 2; my $a = $t{$x}; $t{$y} = $a },
  'v::m' => sub { my ($x, $y) = map @a[$x++ % @a], 1 .. 2; my $a = $v{$x}; $v{$y} = $a }
diff --git a/t/01-import.t b/t/01-import.t
index 9e0139f..1524c9f 100644
--- a/t/01-import.t
+++ b/t/01-import.t
@@ -9,5 +9,5 @@ require Variable::Magic;
 
 for (qw/wizard gensig getsig cast getdata dispell SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR VMG_COMPAT_SCALAR_LENGTH_NOLEN/) {
  eval { Variable::Magic->import($_) };
- ok(!$@, 'import ' . $_);
+ is($@, '', 'import ' . $_);
 }
diff --git a/t/10-simple.t b/t/10-simple.t
index adcbf34..236fc1d 100644
--- a/t/10-simple.t
+++ b/t/10-simple.t
@@ -15,49 +15,49 @@ $args += 4 if VMG_UVAR;
 for (0 .. 20) {
  next if $_ == $args;
  eval { Variable::Magic::_wizard(('hlagh') x $_) };
- ok($@, "_wizard called directly with a wrong number of arguments croaks ($@)");
+ like($@, qr/Wrong\s+number\s+of\s+arguments/, '_wizard called directly with a wrong number of arguments croaks');
 }
 
 for (0 .. 3) {
  eval { wizard(('dong') x (2 * $_ + 1)) };
- ok($@, "wizard called with an odd number of arguments croaks ($@)");
+ like($@, qr/Wrong\s+number\s+of\s+arguments\s+for\s+wizard\(\)/, 'wizard called with an odd number of arguments croaks');
 }
 
 my $sig = gensig;
 
 my $wiz = eval { wizard sig => $sig };
-ok(!$@,                "wizard doesn't croak ($@)");
+is($@, '',             'wizard doesn\'t croak');
 ok(defined $wiz,       'wizard is defined');
 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
 is($sig, getsig $wiz,  'wizard signature is correct');
 
 my $a = 1;
 my $res = eval { cast $a, $wiz };
-ok(!$@,  "cast doesn't croak ($@)");
-ok($res, 'cast is valid');
+is($@, '', 'cast doesn\'t croak');
+ok($res,   'cast is valid');
 
 $res = eval { dispell $a, $wiz };
-ok(!$@,  "dispell from wizard doesn't croak ($@)");
-ok($res, 'dispell from wizard is valid');
+is($@, '', 'dispell from wizard doesn\'t croak');
+ok($res,   'dispell from wizard is valid');
 
 $res = eval { cast $a, $wiz };
-ok(!$@,  "re-cast doesn't croak ($@)");
-ok($res, 're-cast is valid');
+is($@, '', 're-cast doesn\'t croak');
+ok($res,   're-cast is valid');
 
 $res = eval { dispell $a, gensig };
-ok(!$@,            "re-dispell from wrong sig doesn't croak ($@)");
-ok(!defined($res), 're-dispell from wrong sig returns undef');
+is($@, '',      're-dispell from wrong sig doesn\'t croak');
+is($res, undef, 're-dispell from wrong sig doesn\'t return anything');
 
 $res = eval { dispell $a, undef };
-ok($@,             "re-dispell from undef croaks ($@)");
-ok(!defined($res), 're-dispell from undef returns undef');
+like($@, qr/Invalid\s+wizard\s+object/, 're-dispell from undef croaks');
+is($res, undef, 're-dispell from undef doesn\'t return anything');
 
 $res = eval { dispell $a, $sig };
-ok(!$@,  "re-dispell from good sig doesn't croak ($@)");
-ok($res, 're-dispell from good sig is valid');
+is($@, '', 're-dispell from good sig doesn\'t croak');
+ok($res,   're-dispell from good sig is valid');
 
 $res = eval { dispell my $b, $wiz };
-ok(!$@, "dispell non-magic object doesn't croak ($@)");
+is($@, '',  'dispell non-magic object doesn\'t croak');
 is($res, 0, 'dispell non-magic object returns 0');
 
 $sig = gensig;
@@ -68,9 +68,9 @@ $sig = gensig;
 }
 my $c = 3;
 $res = eval { cast $c, $sig };
-ok(!$@, "cast from obsolete signature doesn't croak ($@)");
-ok(!defined($res), 'cast from obsolete signature returns undef');
+is($@, '',      'cast from obsolete signature doesn\'t croak');
+is($res, undef, 'cast from obsolete signature returns undef');
 
 $res = eval { cast $c, undef };
-ok($@, "cast from undef croaks ($@)");
-ok(!defined($res), 'cast from undef returns undef');
+like($@, qr/Invalid\s+numeric\s+signature/, 'cast from undef croaks');
+is($res, undef, 'cast from undef doesn\'t return anything');
diff --git a/t/11-multiple.t b/t/11-multiple.t
index 44da791..519312d 100644
--- a/t/11-multiple.t
+++ b/t/11-multiple.t
@@ -20,11 +20,11 @@ sub multi {
 }
 
 eval { $w[0] = wizard get => sub { ++$c[0] }, set => sub { --$c[0] } };
-ok(!$@, "wizard 0 creation error ($@)");
+is($@, '', 'wizard 0 creation doesn\'t croak');
 eval { $w[1] = wizard get => sub { ++$c[1] }, set => sub { --$c[1] } };
-ok(!$@, "wizard 1 creation error ($@)");
+is($@, '', 'wizard 1 creation doesn\'t croak');
 eval { $w[2] = wizard get => sub { ++$c[2] }, set => sub { --$c[2] } };
-ok(!$@, "wizard 2 creation error ($@)");
+is($@, '', 'wizard 2 creation doesn\'t croak');
 
 multi sub {
  my ($i) = @_;
@@ -42,8 +42,8 @@ multi sub {
  cast $a, $w[$i];
 }, sub {
  my ($i, $res, $err) = @_;
- ok(!$err, "cast magic $i doesn't croak ($err)");
- ok($res,  "cast magic $i is valid");
+ is($err, '', "cast magic $i doesn't croak");
+ ok($res,     "cast magic $i is valid");
 };
 
 my $b = $a;
@@ -53,8 +53,8 @@ $a = 1;
 for (0 .. $n - 1) { is($c[$_], 0, "set magic $_"); }
 
 my $res = eval { dispell $a, $w[1] };
-ok(!$@,  "dispell magic 1 doesn't croak ($@)");
-ok($res, 'dispell magic 1 is valid');
+is($@, '', 'dispell magic 1 doesn\'t croak');
+ok($res,   'dispell magic 1 is valid');
 
 $b = $a;
 for (0, 2) { is($c[$_], 1, "get magic $_ after dispelled 1"); }
@@ -63,8 +63,8 @@ $a = 2;
 for (0, 2) { is($c[$_], 0, "set magic $_ after dispelled 1"); }
 
 $res = eval { dispell $a, $w[0] };
-ok(!$@,  "dispell magic 0 doesn't croak ($@)");
-ok($res, 'dispell magic 0 is valid');
+is($@, '', 'dispell magic 0 doesn\'t croak');
+ok($res,   'dispell magic 0 is valid');
 
 $b = $a;
 is($c[2], 1, 'get magic 2 after dispelled 1 & 0');
@@ -73,8 +73,8 @@ $a = 3;
 is($c[2], 0, 'set magic 2 after dispelled 1 & 0');
 
 $res = eval { dispell $a, $w[2] };
-ok(!$@,  "dispell magic 2 doesn't croak ($@)");
-ok($res, 'dispell magic 2 is valid');
+is($@, '', 'dispell magic 2 doesn\'t croak');
+ok($res,   'dispell magic 2 is valid');
 
 SKIP: {
  skip 'No nice uvar magic for this perl', 41 unless VMG_UVAR;
@@ -83,11 +83,11 @@ SKIP: {
  @c = (0) x $n;
 
  eval { $w[0] = wizard fetch => sub { ++$c[0] }, store => sub { --$c[0] } };
- ok(!$@, "wizard with uvar 0 creation error ($@)");
+ is($@, '', 'wizard with uvar 0 doesn\'t croak');
  eval { $w[1] = wizard fetch => sub { ++$c[1] }, store => sub { --$c[1] } };
- ok(!$@, "wizard with uvar 1 creation error ($@)");
+ is($@, '', 'wizard with uvar 1 doesn\'t croak');
  eval { $w[2] = wizard fetch => sub { ++$c[2] }, store => sub { --$c[2] } };
- ok(!$@, "wizard with uvar 2 creation error ($@)");
+ is($@, '', 'wizard with uvar 2 doesn\'t croak');
 
  multi sub {
   my ($i) = @_;
@@ -105,8 +105,8 @@ SKIP: {
   cast %h, $w[$i];
  }, sub {
   my ($i, $res, $err) = @_;
-  ok(!$err, "cast uvar magic $i doesn't croak ($err)");
-  ok($res,  "cast uvar magic $i is valid");
+  is($err, '', "cast uvar magic $i doesn't croak");
+  ok($res,     "cast uvar magic $i is valid");
  };
 
  my $s = $h{a};
@@ -119,8 +119,8 @@ SKIP: {
  # $c[$_] == 1 for 0 .. 2
 
  my $res = eval { dispell %h, $w[1] };
- ok(!$@,  "dispell uvar magic 1 doesn't croak ($@)");
- ok($res, 'dispell uvar magic 1 is valid');
+ is($@, '', 'dispell uvar magic 1 doesn\'t croak');
+ ok($res,   'dispell uvar magic 1 is valid');
 
  $s = $h{b};
  is($s, 2, 'fetch magic after dispelled 1 doesn\'t clobber');
@@ -132,8 +132,8 @@ SKIP: {
  # $c[$_] == 2 for 0, 2
 
  $res = eval { dispell %h, $w[2] };
- ok(!$@,  "dispell uvar magic 2 doesn't croak ($@)");
- ok($res, 'dispell uvar magic 2 is valid');
+ is($@, '', 'dispell uvar magic 2 doesn\'t croak');
+ ok($res,   'dispell uvar magic 2 is valid');
 
  $s = $h{b};
  is($s, 4, 'fetch magic after dispelled 1,2 doesn\'t clobber');
@@ -145,8 +145,8 @@ SKIP: {
  # $c[$_] == 3 for 0
 
  $res = eval { dispell %h, $w[0] };
- ok(!$@,  "dispell uvar magic 0 doesn't croak ($@)");
- ok($res, 'dispell uvar magic 0 is valid');
+ is($@, '', 'dispell uvar magic 0 doesn\'t croak');
+ ok($res,   'dispell uvar magic 0 is valid');
 
  $s = $h{b};
  is($s, 6, 'fetch magic after dispelled 1,2,0 doesn\'t clobber');
diff --git a/t/12-sig.t b/t/12-sig.t
index fa1a34b..636ad7e 100644
--- a/t/12-sig.t
+++ b/t/12-sig.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+use Test::More tests => 26;
 
 use Variable::Magic qw/wizard getsig cast dispell SIG_MIN/;
 
@@ -13,48 +13,52 @@ my ($a, $b, $c, $d) = 1 .. 4;
 
 {
  my $wiz = eval { wizard sig => $sig };
- ok(!$@, "wizard creation doesn't croak ($@)");
- ok(defined $wiz, 'wizard is defined');
+ is($@, '',             'wizard creation doesn\'t croak');
+ ok(defined $wiz,       'wizard is defined');
  is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
- is($sig, getsig $wiz, 'wizard signature is correct');
+ is($sig, getsig $wiz,  'wizard signature is correct');
 
  my $wiz2 = eval { wizard sig => $sig };
- ok(!$@, "wizard retreive doesn't croak ($@)");
- ok(defined $wiz2, 'retrieved wizard is defined');
+ is($@, '',              'wizard retreive doesn\'t croak');
+ ok(defined $wiz2,       'retrieved wizard is defined');
  is(ref $wiz2, 'SCALAR', 'retrieved wizard is a scalar ref');
- is($sig, getsig $wiz2, 'retrieved wizard signature is correct');
+ is($sig, getsig $wiz2,  'retrieved wizard signature is correct');
+
+ my $wiz3 = eval { wizard sig => [ ] };
+ like($@, qr/Invalid\s+numeric\s+signature/, 'non numeric signature croaks');
+ is($wiz3, undef, 'non numeric signature doesn\'t return anything');
 
  my $a = 1;
  my $res = eval { cast $a, $wiz };
- ok(!$@, "cast from wizard croaks ($@)");
- ok($res, 'cast from wizard invalid');
+ is($@, '', 'cast from wizard doesn\'t croak');
+ ok($res,   'cast from wizard invalid');
 
  $res = eval { dispell $a, $wiz2 };
- ok(!$@, "dispell from retrieved wizard croaks ($@)");
- ok($res, 'dispell from retrieved wizard invalid');
+ is($@, '', 'dispell from retrieved wizard doesn\'t croak');
+ ok($res,   'dispell from retrieved wizard invalid');
 
  $res = eval { cast $b, $sig };
- ok(!$@, "cast from integer croaks ($@)");
- ok($res, 'cast from integer invalid');
+ is($@, '', 'cast from integer doesn\'t croak');
+ 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');
+is($@, '', 'cast from float doesn\'t croak');
+ok($res,   'cast from float invalid');
 
 $res = eval { cast $d, sprintf "%u", $sig };
-ok(!$@, "cast from string croaks ($@)");
-ok($res, 'cast from string invalid');
+is($@, '', 'cast from string doesn\'t croak');
+ok($res,   'cast from string invalid');
 
 $res = eval { dispell $b, $sig };
-ok(!$@, "dispell from integer croaks ($@)");
-ok($res, 'dispell from integer invalid');
+is($@, '', 'dispell from integer doesn\'t croak');
+ok($res,   'dispell from integer invalid');
 
 $res = eval { dispell $c, $sig + 0.1 };
-ok(!$@, "dispell from float croaks ($@)");
-ok($res, 'dispell from float invalid');
+is($@, '', 'dispell from float doesn\'t croak');
+ok($res,   'dispell from float invalid');
 
 $res = eval { dispell $d, sprintf "%u", $sig };
-ok(!$@, "dispell from string croaks ($@)");
-ok($res, 'dispell from string invalid');
+is($@, '', 'dispell from string doesn\'t croak');
+ok($res,   'dispell from string invalid');
 
diff --git a/t/13-data.t b/t/13-data.t
index 313e1df..512290b 100644
--- a/t/13-data.t
+++ b/t/13-data.t
@@ -16,30 +16,30 @@ my $wiz = eval {
          get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
          set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
 };
-ok(!$@,                "wizard doesn't croak ($@)");
+is($@, '',             'wizard doesn\'t croak');
 ok(defined $wiz,       'wizard is defined');
 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
 
 my $a = 75;
 my $res = eval { cast $a, $wiz };
-ok(!$@,  "cast does't croak ($@)");
-ok($res, 'cast returns true');
+is($@, '', 'cast doesn\'t croak');
+ok($res,   'cast returns true');
 
 my $data = eval { getdata $a, $wiz };
-ok(!$@,   "getdata from wizard doesn't croak ($@)");
-ok($res,  'getdata from wizard returns true');
+is($@, '', 'getdata from wizard doesn\'t croak');
+ok($res,   'getdata from wizard returns true');
 is_deeply($data, { foo => 12, bar => 27 },
-          'getdata from wizard return value is ok');
+           'getdata from wizard return value is ok');
 
 $data = eval { getdata my $b, $wiz };
-ok(!$@,             "getdata from non-magical scalar doesn't croak ($@)");
-ok(!defined($data), 'getdata from non-magical scalar returns undef');
+is($@, '',       'getdata from non-magical scalar doesn\'t croak');
+is($data, undef, 'getdata from non-magical scalar returns undef');
 
 $data = eval { getdata $a, $sig };
-ok(!$@,   "getdata from sig doesn't croak ($@)");
-ok($res,  'getdata from sig returns true');
+is($@, '', 'getdata from sig doesn\'t croak');
+ok($res,   'getdata from sig returns true');
 is_deeply($data, { foo => 12, bar => 27 },
-          'getdata from sig return value is ok');
+           'getdata from sig return value is ok');
 
 my $b = $a;
 is($c,           13, 'get magic : pass data');
@@ -50,34 +50,34 @@ is($c,           40, 'set magic : pass data');
 is($data->{bar}, 40, 'set magic : pass data');
 
 $data = eval { getdata $a, ($sig + 1) };
-ok(!$@,             "getdata from invalid sig doesn't croak ($@)");
-ok(!defined($data), 'getdata from invalid sig returns undef');
+is($@, '',       'getdata from invalid sig doesn\'t croak');
+is($data, undef, 'getdata from invalid sig returns undef');
 
 $data = eval { getdata $a, undef };
-ok($@,              "getdata from undef croaks ($@)");
-ok(!defined($data), 'getdata from undef returns undef');
+like($@, qr/Invalid\s+wizard\s+object/, 'getdata from undef croaks');
+is($data, undef, 'getdata from undef doesn\'t return anything');
 
 $res = eval { dispell $a, $wiz };
-ok(!$@,  "dispell doesn't croak ($@)");
-ok($res, 'dispell returns true');
+is($@, '', 'dispell doesn\'t croak');
+ok($res,   'dispell returns true');
 
 $res = eval { cast $a, $wiz, qw/z j t/ };
-ok(!$@,  "cast with arguments doesn't croak ($@)");
-ok($res, 'cast with arguments returns true');
+is($@, '', 'cast with arguments doesn\'t croak');
+ok($res,   'cast with arguments returns true');
 
 $data = eval { getdata $a, $wiz };
-ok(!$@,   "getdata from wizard with arguments doesn't croak ($@)");
-ok($res,  'getdata from wizard with arguments returns true');
+is($@, '', 'getdata from wizard with arguments doesn\'t croak');
+ok($res,   'getdata from wizard with arguments returns true');
 is_deeply($data, { foo => 'z', bar => 't' },
-          'getdata from wizard with arguments return value is ok');
+           'getdata from wizard with arguments return value is ok');
 
 $wiz = wizard get => sub { };
 dispell $a, $sig;
 $a = 63;
 $res = eval { cast $a, $wiz };
-ok(!$@,  "cast non-data wizard doesn't croak ($@)");
-ok($res, 'cast non-data wizard returns true');
+is($@, '', 'cast non-data wizard doesn\'t croak');
+ok($res,   'cast non-data wizard returns true');
 
 $data = eval { getdata $a, $wiz };
-ok(!$@,             "getdata from non-data wizard doesn't croak ($@)");
-ok(!defined($data), 'getdata from non-data wizard invalid returns undef');
+is($@, '',       'getdata from non-data wizard doesn\'t croak');
+is($data, undef, 'getdata from non-data wizard invalid returns undef');
diff --git a/t/14-callbacks.t b/t/14-callbacks.t
index dffb6d9..f3e3335 100644
--- a/t/14-callbacks.t
+++ b/t/14-callbacks.t
@@ -8,21 +8,21 @@ use Test::More tests => 7;
 use Variable::Magic qw/wizard cast/;
 
 my $wiz = eval { wizard get => sub { undef } };
-ok(!$@, "wizard creation doesn't croak ($@)");
-ok(defined $wiz, 'wizard is defined');
+is($@, '',             'wizard creation doesn\'t croak');
+ok(defined $wiz,       'wizard is defined');
 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
 
 my $n = int rand 1000;
 my $a = $n;
 
 my $res = eval { cast $a, $wiz };
-ok(!$@, "cast doesn't croak ($@)");
-ok($res, 'cast is valid');
+is($@, '', 'cast doesn\'t croak');
+ok($res,   'cast is valid');
 
 my $x;
 eval {
  local $SIG{__WARN__} = sub { die };
  $x = $a
 };
-ok(!$@, 'callback returning undef doesn\'t warn/croak');
+is($@, '', 'callback returning undef doesn\'t warn/croak');
 is($x, $n, 'callback returning undef fails');
diff --git a/t/15-self.t b/t/15-self.t
index cff8429..cee1dbd 100644
--- a/t/15-self.t
+++ b/t/15-self.t
@@ -15,39 +15,39 @@ my $c = 0;
          get  => sub { ++$c },
          free => sub { --$c }
  };
- ok(!$@, "wizard creation error ($@)");
- ok(defined $wiz, 'wizard is defined');
+ is($@, '',             'wizard creation error doesn\'t croak');
+ ok(defined $wiz,       'wizard is defined');
  is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
 
  my $res = eval { cast $wiz, $wiz };
- ok(!$@, "cast on self doesn't croak ($@)");
- ok($res, 'cast on self is valid');
+ is($@, '', 'cast on self doesn\'t croak');
+ ok($res,   'cast on self is valid');
 
  my $w = $wiz;
  is($c, 1, 'magic works correctly on self');
 
  $res = eval { dispell $wiz, $wiz };
- ok(!$@, "dispell on self doesn't croak ($@)");
- ok($res, 'dispell on self is valid');
+ is($@, '', 'dispell on self doesn\'t croak');
+ ok($res,   'dispell on self is valid');
 
  $w = $wiz;
  is($c, 1, 'magic is no longer invoked on self when dispelled');
 
  $res = eval { cast $wiz, $wiz, $wiz };
- ok(!$@, "re-cast on self doesn't croak ($@)");
- ok($res, 're-cast on self is valid');
+ is($@, '', 're-cast on self doesn\'t croak');
+ ok($res,   're-cast on self is valid');
 
  $w = getdata $wiz, $wiz;
  is($c, 1, 'getdata on magical self doesn\'t trigger callbacks');
  # is(getsig($w), getsig($wiz), 'getdata returns the correct wizard');
 
  $res = eval { dispell $wiz, $wiz };
- ok(!$@, "re-dispell on self doesn't croak ($@)");
- ok($res, 're-dispell on self is valid');
+ is($@, '', 're-dispell on self doesn\'t croak');
+ ok($res,   're-dispell on self is valid');
 
  $res = eval { cast $wiz, $wiz };
- ok(!$@, "re-re-cast on self doesn't croak ($@)");
- ok($res, 're-re-cast on self is valid');
+ is($@, '', 're-re-cast on self doesn\'t croak');
+ ok($res,   're-re-cast on self is valid');
 }
 
 # is($c, 0, 'magic destructor is called');
diff --git a/t/16-huf.t b/t/16-huf.t
index 0941fb2..c19d849 100644
--- a/t/16-huf.t
+++ b/t/16-huf.t
@@ -29,13 +29,13 @@ $h{$obj} = 5;
 my ($w, $c) = (undef, 0);
 
 eval { $w = wizard fetch => sub { ++$c }, store => sub { --$c } };
-ok(!$@,              "wizard with uvar doesn't croak ($@)");
+is($@, '',           'wizard with uvar doesn\'t croak');
 ok(defined $w,       'wizard with uvar is defined');
 is(ref $w, 'SCALAR', 'wizard with uvar is a scalar ref');
 
 my $res = eval { cast %h, $w };
-ok(!$@,  "cast uvar magic on fieldhash doesn't croak ($@)");
-ok($res, 'cast uvar magic on fieldhash is valid');
+is($@, '', 'cast uvar magic on fieldhash doesn\'t croak');
+ok($res,   'cast uvar magic on fieldhash is valid');
 
 my $s = $h{$obj};
 is($s, 5, 'fetch magic on fieldhash doesn\'t clobber');
@@ -46,8 +46,8 @@ is($c, 0,       'store magic on fieldhash');
 is($h{$obj}, 7, 'store magic on fieldhash doesn\'t clobber'); # $c == 1
 
 $res = eval { dispell %h, $w };
-ok(!$@,  "dispell uvar magic on fieldhash doesn't croak ($@)");
-ok($res, 'dispell uvar magic on fieldhash is valid');
+is($@, '', 'dispell uvar magic on fieldhash doesn\'t croak');
+ok($res,   'dispell uvar magic on fieldhash is valid');
 
 $h{$obj} = 11;
 $s = $h{$obj};
diff --git a/t/28-uvar.t b/t/28-uvar.t
index 7fa30b1..4800c44 100644
--- a/t/28-uvar.t
+++ b/t/28-uvar.t
@@ -75,12 +75,12 @@ eval {
  local $SIG{__WARN__} = sub { die };
  $x = $h2{a};
 };
-ok(!$@,    'uvar : fetch with incomplete magic');
+is($@, '', 'uvar : fetch with incomplete magic');
 is($x, 37, 'uvar : fetch with incomplete magic correctly');
 
 eval {
  local $SIG{__WARN__} = sub { die };
  $h2{a} = 73;
 };
-ok(!$@,        'uvar : store with incomplete magic');
+is($@, '',     'uvar : store with incomplete magic');
 is($h2{a}, 73, 'uvar : store with incomplete magic correctly');
diff --git a/t/33-code.t b/t/33-code.t
index 40c32a4..4b9cd20 100644
--- a/t/33-code.t
+++ b/t/33-code.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More tests => 14;
 
 use Variable::Magic qw/wizard cast dispell/;
 
@@ -32,40 +32,37 @@ my $wiz = wizard get   => sub { ++$c[0] },
 check('code : create wizard');
 
 my $x = 0;
-my $n = sub { ++$x };
-my $a = $n;
+sub hlagh { ++$x };
 
-cast $a, $wiz;
+cast &hlagh, $wiz;
 check('code : cast');
 
-my $b = $a;
-++$x[0];
-check('code : assign to');
+hlagh();
+check('code : call without arguments');
+is($x, 1, 'code : call without arguments succeeded');
 
-$b = "X${a}Y";
-++$x[0];
-check('code : interpolate');
+hlagh(1, 2, 3);
+check('code : call with arguments');
+is($x, 2, 'code : call with arguments succeeded');
 
-$b = \$a;
-check('code : reference');
+undef *hlagh;
+++$x[4];
+check('code : undef symbol table');
+is($x, 2, 'code : undef symbol table didn\'t call');
 
-$a = $n;
-++$x[1];
-check('code : assign');
+my $y = 0;
+*hlagh = sub { ++$y };
 
-$a->();
-check('code : call');
+cast &hlagh, $wiz;
+check('code : re-cast');
 
-{
- my $b = $n;
- cast $b, $wiz;
-}
-++$x[4];
-check('code : scope end');
+my $r = \&hlagh;
+check('code : take reference');
 
-undef $a;
-++$x[1];
-check('code : undef');
+$r->();
+check('code : call reference');
+is($y, 1, 'code : call reference succeeded');
+is($x, 2, 'code : call reference didn\'t triggered the previous code');
 
-dispell $a, $wiz;
+dispell &hlagh, $wiz;
 check('code : dispell');