]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blobdiff - t/25-copy.t
Importing Variable-Magic-0.13.tar.gz
[perl/modules/Variable-Magic.git] / t / 25-copy.t
index 3a033a3b5e890ec6b7af648b8bff193a3cbc0991..83e604a2485b5603cfd0f01870c0c97a36d1c2c0 100644 (file)
@@ -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');
 }