]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/15-self.t
Skip NULL values when walking a table
[perl/modules/Variable-Magic.git] / 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 my $c = 0;
11
12 {
13  my $wiz = eval {
14   wizard data => sub { $_[0] },
15          get  => sub { ++$c },
16          free => sub { --$c }
17  };
18  is($@, '',             'wizard creation error doesn\'t croak');
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  is($@, '', '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  is($@, '', '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  is($@, '', '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
43  $res = eval { dispell $wiz, $wiz };
44  is($@, '', 're-dispell on self doesn\'t croak');
45  ok($res,   're-dispell on self is valid');
46
47  $res = eval { cast $wiz, $wiz };
48  is($@, '', 're-re-cast on self doesn\'t croak');
49  ok($res,   're-re-cast on self is valid');
50 }
51
52 eval q[
53  use lib 't/lib';
54  BEGIN { require Variable::Magic::TestDestroyRequired; }
55 ];
56 is $@, '', 'wizard destruction at the end of BEGIN-time require doesn\'t panic';
57
58 if ((defined $ENV{PERL_DESTRUCT_LEVEL} and $ENV{PERL_DESTRUCT_LEVEL} >= 3)
59     or eval "use Perl::Destruct::Level level => 3; 1") {
60  diag 'Test global destruction';
61 }