X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F25-copy.t;h=83e604a2485b5603cfd0f01870c0c97a36d1c2c0;hb=refs%2Ftags%2Fv0.13;hp=3a033a3b5e890ec6b7af648b8bff193a3cbc0991;hpb=fee1a480bc5d827590dc7394e0a77741bad86dc3;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/25-copy.t b/t/25-copy.t index 3a033a3..83e604a 100644 --- a/t/25-copy.t +++ b/t/25-copy.t @@ -15,7 +15,7 @@ if (MGf_COPY) { my $c = 0; my $wiz = wizard 'copy' => sub { ++$c }; -ok($c == 0, 'copy : create wizard'); +is($c, 0, 'copy : create wizard'); SKIP: { eval "use Tie::Array"; @@ -25,22 +25,22 @@ SKIP: { @a = (1 .. 10); my $res = cast @a, $wiz; - ok($res, 'copy : cast on array succeeded'); - ok($c == 0, 'copy : cast on array didn\'t triggered the callback'); + ok($res, 'copy : cast on array succeeded'); + is($c, 0, 'copy : cast on array didn\'t triggered the callback'); $a[3] = 13; - ok($c == 1, 'copy : callback triggers on array store'); + is($c, 1, 'copy : callback triggers on array store'); my $s = $a[3]; - ok($c == 2, 'copy : callback triggers on array fetch'); - ok($s == 13, 'copy : array fetch is correct'); + is($c, 2, 'copy : callback triggers on array fetch'); + is($s, 13, 'copy : array fetch is correct'); $s = exists $a[3]; - ok($c == 3, 'copy : callback triggers on array exists'); - ok($s, 'copy : array exists is correct'); + is($c, 3, 'copy : callback triggers on array exists'); + ok($s, 'copy : array exists is correct'); undef @a; - ok($c == 3, 'copy : callback doesn\'t trigger on array undef'); + is($c, 3, 'copy : callback doesn\'t trigger on array undef'); } SKIP: { @@ -52,34 +52,34 @@ SKIP: { $c = 0; my $res = cast %h, $wiz; - ok($res, 'copy : cast on hash succeeded'); - ok($c == 0, 'copy : cast on hash didn\'t triggered the callback'); + ok($res, 'copy : cast on hash succeeded'); + is($c, 0, 'copy : cast on hash didn\'t triggered the callback'); $h{b} = 7; - ok($c == 1, 'copy : callback triggers on hash store'); + is($c, 1, 'copy : callback triggers on hash store'); my $s = $h{c}; - ok($c == 2, 'copy : callback triggers on hash fetch'); - ok($s == 3, 'copy : hash fetch is correct'); + is($c, 2, 'copy : callback triggers on hash fetch'); + is($s, 3, 'copy : hash fetch is correct'); $s = exists $h{a}; - ok($c == 3, 'copy : callback triggers on hash exists'); - ok($s, 'copy : hash exists is correct'); + is($c, 3, 'copy : callback triggers on hash exists'); + ok($s, 'copy : hash exists is correct'); $s = delete $h{b}; - ok($c == 4, 'copy : callback triggers on hash delete'); - ok($s == 7, 'copy : hash delete is correct'); + is($c, 4, 'copy : callback triggers on hash delete'); + is($s, 7, 'copy : hash delete is correct'); my ($k, $v) = each %h; - ok($c == 5, 'copy : callback triggers on hash each'); + is($c, 5, 'copy : callback triggers on hash each'); my @k = keys %h; - ok($c == 5, 'copy : callback doesn\'t trigger on hash keys'); + is($c, 5, 'copy : callback doesn\'t trigger on hash keys'); my @v = values %h; - ok(@v == 2, 'copy : two values in the hash'); - ok($c == 7, 'copy : callback triggers on hash values'); + is(scalar @v, 2, 'copy : two values in the hash'); + is($c, 7, 'copy : callback triggers on hash values'); undef %h; - ok($c == 7, 'copy : callback doesn\'t trigger on hash undef'); + is($c, 7, 'copy : callback doesn\'t trigger on hash undef'); }