]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/13-data.t
Convert t/30-scalar.t to the new testing framework
[perl/modules/Variable-Magic.git] / t / 13-data.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 38;
7
8 use Variable::Magic qw/wizard getdata cast dispell SIG_MIN/;
9
10 my $c = 1;
11
12 my $sig = SIG_MIN;
13 my $wiz = eval {
14  wizard  sig => $sig,
15         data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } },
16          get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
17          set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
18 };
19 is($@, '',             'wizard doesn\'t croak');
20 ok(defined $wiz,       'wizard is defined');
21 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
22
23 my $a = 75;
24 my $res = eval { cast $a, $wiz };
25 is($@, '', 'cast doesn\'t croak');
26 ok($res,   'cast returns true');
27
28 my $data = eval { getdata $a, $wiz };
29 is($@, '', 'getdata from wizard doesn\'t croak');
30 ok($res,   'getdata from wizard returns true');
31 is_deeply($data, { foo => 12, bar => 27 },
32            'getdata from wizard return value is ok');
33
34 $data = eval { getdata my $b, $wiz };
35 is($@, '',       'getdata from non-magical scalar doesn\'t croak');
36 is($data, undef, 'getdata from non-magical scalar returns undef');
37
38 $data = eval { getdata $a, $sig };
39 is($@, '', 'getdata from sig doesn\'t croak');
40 ok($res,   'getdata from sig returns true');
41 is_deeply($data, { foo => 12, bar => 27 },
42            'getdata from sig return value is ok');
43
44 my $b = $a;
45 is($c,           13, 'get magic : pass data');
46 is($data->{foo}, 13, 'get magic : data updated');
47
48 $a = 57;
49 is($c,           40, 'set magic : pass data');
50 is($data->{bar}, 40, 'set magic : pass data');
51
52 $data = eval { getdata $a, ($sig + 1) };
53 is($@, '',       'getdata from invalid sig doesn\'t croak');
54 is($data, undef, 'getdata from invalid sig returns undef');
55
56 $data = eval { getdata $a, undef };
57 like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from undef croaks');
58 is($data, undef, 'getdata from undef doesn\'t return anything');
59
60 $res = eval { dispell $a, $wiz };
61 is($@, '', 'dispell doesn\'t croak');
62 ok($res,   'dispell returns true');
63
64 $res = eval { cast $a, $wiz, qw/z j t/ };
65 is($@, '', 'cast with arguments doesn\'t croak');
66 ok($res,   'cast with arguments returns true');
67
68 $data = eval { getdata $a, $wiz };
69 is($@, '', 'getdata from wizard with arguments doesn\'t croak');
70 ok($res,   'getdata from wizard with arguments returns true');
71 is_deeply($data, { foo => 'z', bar => 't' },
72            'getdata from wizard with arguments return value is ok');
73
74 $wiz = wizard get => sub { };
75 dispell $a, $sig;
76 $a = 63;
77 $res = eval { cast $a, $wiz };
78 is($@, '', 'cast non-data wizard doesn\'t croak');
79 ok($res,   'cast non-data wizard returns true');
80
81 $data = eval { getdata $a, $wiz };
82 is($@, '',       'getdata from non-data wizard doesn\'t croak');
83 is($data, undef, 'getdata from non-data wizard invalid returns undef');
84
85 $wiz = wizard data => sub { ++$_[1] };
86 my ($di, $ei) = (1, 10);
87 my ($d, $e);
88 cast $d, $wiz, $di;
89 cast $e, $wiz, $ei;
90 my $dd = getdata $d, $wiz;
91 my $ed = getdata $e, $wiz;
92 is($dd, 2,  'data from d is what we expected');
93 is($di, 2,  'cast arguments from d were passed by alias');
94 is($ed, 11, 'data from e is what we expected');
95 is($ei, 11, 'cast arguments from e were passed by alias');
96 $di *= 2;
97 $dd = getdata $d, $wiz;
98 $ed = getdata $e, $wiz;
99 is($dd, 2,  'data from d wasn\'t changed');
100 is($ed, 11, 'data from e wasn\'t changed');