t/15-self.t

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