X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F28-uvar.t;h=7fa30b124301accd0f9a1cf13f5d05e7d5de7ba4;hb=a86e3e47a167afadf7de1231d6401a1139330ad0;hp=364c7cddb73bcf746334601985cbd2b20fb53d21;hpb=56d08a38a664736a762edf46817a346482c4004f;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/28-uvar.t b/t/28-uvar.t index 364c7cd..7fa30b1 100644 --- a/t/28-uvar.t +++ b/t/28-uvar.t @@ -17,53 +17,54 @@ my @c = (0) x 4; my @x = (0) x 4; sub check { - for (0 .. 3) { return 0 unless $c[$_] == $x[$_]; } - return 1; + is join(':', map { (defined) ? $_ : 'u' } @c[0 .. 3]), + join(':', map { (defined) ? $_ : 'u' } @x[0 .. 3]), + $_[0]; } my $wiz = wizard 'fetch' => sub { ++$c[0] }, 'store' => sub { ++$c[1] }, 'exists' => sub { ++$c[2] }, 'delete' => sub { ++$c[3] }; -ok(check(), 'uvar : create wizard'); +check('uvar : create wizard'); my %h = (a => 1, b => 2, c => 3); my $res = cast %h, $wiz; -ok($res, 'uvar : cast succeeded'); -ok(check(), 'uvar : cast didn\'t triggered the callback'); +ok($res, 'uvar : cast succeeded'); +check( 'uvar : cast didn\'t triggered the callback'); my $x = $h{a}; ++$x[0]; -ok(check(), 'uvar : fetch directly'); -ok($x, 'uvar : fetch directly correctly'); +check( 'uvar : fetch directly'); +ok($x, 'uvar : fetch directly correctly'); $x = "$h{b}"; ++$x[0]; -ok(check(), 'uvar : fetch by interpolation'); -ok($x == 2, 'uvar : fetch by interpolation correctly'); +check( 'uvar : fetch by interpolation'); +is($x, 2, 'uvar : fetch by interpolation correctly'); $h{c} = 4; ++$x[1]; -ok(check(), 'uvar : store directly'); +check('uvar : store directly'); $x = $h{c} = 5; ++$x[1]; -ok(check(), 'uvar : fetch and store'); -ok($x == 5, 'uvar : fetch and store correctly'); +check( 'uvar : fetch and store'); +is($x, 5, 'uvar : fetch and store correctly'); $x = exists $h{c}; ++$x[2]; -ok(check(), 'uvar : exists'); -ok($x, 'uvar : exists correctly'); +check( 'uvar : exists'); +ok($x, 'uvar : exists correctly'); $x = delete $h{c}; ++$x[3]; -ok(check(), 'uvar : delete existing key'); -ok($x == 5, 'uvar : delete existing key correctly'); +check( 'uvar : delete existing key'); +is($x, 5, 'uvar : delete existing key correctly'); $x = delete $h{z}; ++$x[3]; -ok(check(), 'uvar : delete non-existing key'); +check( 'uvar : delete non-existing key'); ok(!defined $x, 'uvar : delete non-existing key correctly'); my $wiz2 = wizard 'fetch' => sub { 0 }; @@ -74,12 +75,12 @@ eval { local $SIG{__WARN__} = sub { die }; $x = $h2{a}; }; -ok(!$@, 'uvar : fetch with incomplete magic'); -ok($x == 37, 'uvar : fetch with incomplete magic correctly'); +ok(!$@, 'uvar : fetch with incomplete magic'); +is($x, 37, 'uvar : fetch with incomplete magic correctly'); eval { local $SIG{__WARN__} = sub { die }; $h2{a} = 73; }; -ok(!$@, 'uvar : store with incomplete magic'); -ok($h2{a} == 73, 'uvar : store with incomplete magic correctly'); +ok(!$@, 'uvar : store with incomplete magic'); +is($h2{a}, 73, 'uvar : store with incomplete magic correctly');