X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F13-data.t;h=bc4248e9e4f05d54a2fdfad687ef0a4366f3c806;hb=HEAD;hp=313e1df530db510eef8e7545d8777b9157e64559;hpb=a86e3e47a167afadf7de1231d6401a1139330ad0;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/13-data.t b/t/13-data.t index 313e1df..bc4248e 100644 --- a/t/13-data.t +++ b/t/13-data.t @@ -3,43 +3,35 @@ use strict; use warnings; -use Test::More tests => 32; +use Test::More tests => 35; -use Variable::Magic qw/wizard getdata cast dispell SIG_MIN/; +use Variable::Magic qw; my $c = 1; -my $sig = SIG_MIN; my $wiz = eval { - wizard sig => $sig, - data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } }, + wizard data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } }, get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c }, set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c } }; -ok(!$@, "wizard doesn't croak ($@)"); +is($@, '', 'wizard doesn\'t croak'); ok(defined $wiz, 'wizard is defined'); is(ref $wiz, 'SCALAR', 'wizard is a scalar ref'); my $a = 75; my $res = eval { cast $a, $wiz }; -ok(!$@, "cast does't croak ($@)"); -ok($res, 'cast returns true'); +is($@, '', 'cast doesn\'t croak'); +ok($res, 'cast returns true'); -my $data = eval { getdata $a, $wiz }; -ok(!$@, "getdata from wizard doesn't croak ($@)"); -ok($res, 'getdata from wizard returns true'); -is_deeply($data, { foo => 12, bar => 27 }, - 'getdata from wizard return value is ok'); - -$data = eval { getdata my $b, $wiz }; -ok(!$@, "getdata from non-magical scalar doesn't croak ($@)"); -ok(!defined($data), 'getdata from non-magical scalar returns undef'); +my $data = eval { getdata my $b, $wiz }; +is($@, '', 'getdata from non-magical scalar doesn\'t croak'); +is($data, undef, 'getdata from non-magical scalar returns undef'); -$data = eval { getdata $a, $sig }; -ok(!$@, "getdata from sig doesn't croak ($@)"); -ok($res, 'getdata from sig returns true'); +$data = eval { getdata $a, $wiz }; +is($@, '', 'getdata from wizard doesn\'t croak'); +ok($res, 'getdata from wizard returns true'); is_deeply($data, { foo => 12, bar => 27 }, - 'getdata from sig return value is ok'); + 'getdata from wizard return value is ok'); my $b = $a; is($c, 13, 'get magic : pass data'); @@ -49,35 +41,53 @@ $a = 57; is($c, 40, 'set magic : pass data'); is($data->{bar}, 40, 'set magic : pass data'); -$data = eval { getdata $a, ($sig + 1) }; -ok(!$@, "getdata from invalid sig doesn't croak ($@)"); -ok(!defined($data), 'getdata from invalid sig returns undef'); +$data = eval { getdata $a, \"blargh" }; +like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from invalid wizard croaks'); +is($data, undef, 'getdata from invalid wizard returns undef'); $data = eval { getdata $a, undef }; -ok($@, "getdata from undef croaks ($@)"); -ok(!defined($data), 'getdata from undef returns undef'); +like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from undef croaks'); +is($data, undef, 'getdata from undef doesn\'t return anything'); $res = eval { dispell $a, $wiz }; -ok(!$@, "dispell doesn't croak ($@)"); -ok($res, 'dispell returns true'); +is($@, '', 'dispell doesn\'t croak'); +ok($res, 'dispell returns true'); -$res = eval { cast $a, $wiz, qw/z j t/ }; -ok(!$@, "cast with arguments doesn't croak ($@)"); -ok($res, 'cast with arguments returns true'); +$res = eval { cast $a, $wiz, qw }; +is($@, '', 'cast with arguments doesn\'t croak'); +ok($res, 'cast with arguments returns true'); $data = eval { getdata $a, $wiz }; -ok(!$@, "getdata from wizard with arguments doesn't croak ($@)"); -ok($res, 'getdata from wizard with arguments returns true'); +is($@, '', 'getdata from wizard with arguments doesn\'t croak'); +ok($res, 'getdata from wizard with arguments returns true'); is_deeply($data, { foo => 'z', bar => 't' }, - 'getdata from wizard with arguments return value is ok'); + 'getdata from wizard with arguments return value is ok'); + +dispell $a, $wiz; $wiz = wizard get => sub { }; -dispell $a, $sig; $a = 63; $res = eval { cast $a, $wiz }; -ok(!$@, "cast non-data wizard doesn't croak ($@)"); -ok($res, 'cast non-data wizard returns true'); - -$data = eval { getdata $a, $wiz }; -ok(!$@, "getdata from non-data wizard doesn't croak ($@)"); -ok(!defined($data), 'getdata from non-data wizard invalid returns undef'); +is($@, '', 'cast non-data wizard doesn\'t croak'); +ok($res, 'cast non-data wizard returns true'); + +my @data = eval { getdata $a, $wiz }; +is($@, '', 'getdata from non-data wizard doesn\'t croak'); +is_deeply(\@data, [ ], 'getdata from non-data wizard invalid returns undef'); + +$wiz = wizard data => sub { ++$_[1] }; +my ($di, $ei) = (1, 10); +my ($d, $e); +cast $d, $wiz, $di; +cast $e, $wiz, $ei; +my $dd = getdata $d, $wiz; +my $ed = getdata $e, $wiz; +is($dd, 2, 'data from d is what we expected'); +is($di, 2, 'cast arguments from d were passed by alias'); +is($ed, 11, 'data from e is what we expected'); +is($ei, 11, 'cast arguments from e were passed by alias'); +$di *= 2; +$dd = getdata $d, $wiz; +$ed = getdata $e, $wiz; +is($dd, 2, 'data from d wasn\'t changed'); +is($ed, 11, 'data from e wasn\'t changed');