t/15-self.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 16;
   7
   8 use Variable::Magic qw/wizard cast dispell getdata getsig/;
   9
  10 my $c = 0;
  11
  12 {
  13  my $wiz = eval {
  14   wizard data => sub { $_[0] },
  15          get  => sub { ++$c },
  16          free => sub { --$c }
  17  };
  18  ok(!$@, "wizard creation error ($@)");
  19  ok(defined $wiz, 'wizard is defined');
  20  is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
  21
  22  my $res = eval { cast $wiz, $wiz };
  23  ok(!$@, "cast on self doesn't croak ($@)");
  24  ok($res, 'cast on self is valid');
  25
  26  my $w = $wiz;
  27  is($c, 1, 'magic works correctly on self');
  28
  29  $res = eval { dispell $wiz, $wiz };
  30  ok(!$@, "dispell on self doesn't croak ($@)");
  31  ok($res, 'dispell on self is valid');
  32
  33  $w = $wiz;
  34  is($c, 1, 'magic is no longer invoked on self when dispelled');
  35
  36  $res = eval { cast $wiz, $wiz, $wiz };
  37  ok(!$@, "re-cast on self doesn't croak ($@)");
  38  ok($res, 're-cast on self is valid');
  39
  40  $w = getdata $wiz, $wiz;
  41  is($c, 1, 'getdata on magical self doesn\'t trigger callbacks');
  42  # is(getsig($w), getsig($wiz), 'getdata returns the correct wizard');
  43
  44  $res = eval { dispell $wiz, $wiz };
  45  ok(!$@, "re-dispell on self doesn't croak ($@)");
  46  ok($res, 're-dispell on self is valid');
  47
  48  $res = eval { cast $wiz, $wiz };
  49  ok(!$@, "re-re-cast on self doesn't croak ($@)");
  50  ok($res, 're-re-cast on self is valid');
  51 }
  52
  53 # is($c, 0, 'magic destructor is called');