6 use Test::More tests => 35;
8 use Variable::Magic qw/wizard getdata cast dispell/;
13 wizard data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } },
14 get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
15 set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
17 is($@, '', 'wizard doesn\'t croak');
18 ok(defined $wiz, 'wizard is defined');
19 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
22 my $res = eval { cast $a, $wiz };
23 is($@, '', 'cast doesn\'t croak');
24 ok($res, 'cast returns true');
26 my $data = eval { getdata my $b, $wiz };
27 is($@, '', 'getdata from non-magical scalar doesn\'t croak');
28 is($data, undef, 'getdata from non-magical scalar returns undef');
30 $data = eval { getdata $a, $wiz };
31 is($@, '', 'getdata from wizard doesn\'t croak');
32 ok($res, 'getdata from wizard returns true');
33 is_deeply($data, { foo => 12, bar => 27 },
34 'getdata from wizard return value is ok');
37 is($c, 13, 'get magic : pass data');
38 is($data->{foo}, 13, 'get magic : data updated');
41 is($c, 40, 'set magic : pass data');
42 is($data->{bar}, 40, 'set magic : pass data');
44 $data = eval { getdata $a, \"blargh" };
45 like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from invalid wizard croaks');
46 is($data, undef, 'getdata from invalid wizard returns undef');
48 $data = eval { getdata $a, undef };
49 like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from undef croaks');
50 is($data, undef, 'getdata from undef doesn\'t return anything');
52 $res = eval { dispell $a, $wiz };
53 is($@, '', 'dispell doesn\'t croak');
54 ok($res, 'dispell returns true');
56 $res = eval { cast $a, $wiz, qw/z j t/ };
57 is($@, '', 'cast with arguments doesn\'t croak');
58 ok($res, 'cast with arguments returns true');
60 $data = eval { getdata $a, $wiz };
61 is($@, '', 'getdata from wizard with arguments doesn\'t croak');
62 ok($res, 'getdata from wizard with arguments returns true');
63 is_deeply($data, { foo => 'z', bar => 't' },
64 'getdata from wizard with arguments return value is ok');
68 $wiz = wizard get => sub { };
70 $res = eval { cast $a, $wiz };
71 is($@, '', 'cast non-data wizard doesn\'t croak');
72 ok($res, 'cast non-data wizard returns true');
74 my @data = eval { getdata $a, $wiz };
75 is($@, '', 'getdata from non-data wizard doesn\'t croak');
76 is_deeply(\@data, [ ], 'getdata from non-data wizard invalid returns undef');
78 $wiz = wizard data => sub { ++$_[1] };
79 my ($di, $ei) = (1, 10);
83 my $dd = getdata $d, $wiz;
84 my $ed = getdata $e, $wiz;
85 is($dd, 2, 'data from d is what we expected');
86 is($di, 2, 'cast arguments from d were passed by alias');
87 is($ed, 11, 'data from e is what we expected');
88 is($ei, 11, 'cast arguments from e were passed by alias');
90 $dd = getdata $d, $wiz;
91 $ed = getdata $e, $wiz;
92 is($dd, 2, 'data from d wasn\'t changed');
93 is($ed, 11, 'data from e wasn\'t changed');