t/32-hash.t

   1 #!perl -T
   2
   3 use Test::More tests => 17;
   4
   5 use Variable::Magic qw/wizard cast dispell/;
   6
   7 my @c = (0) x 5;
   8 my @x = (0) x 5;
   9
  10 sub check {
  11  for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; }
  12  return 1;
  13 }
  14
  15 my $wiz = wizard get   => sub { ++$c[0] },
  16                  set   => sub { ++$c[1] },
  17                  len   => sub { ++$c[2]; $_[2] },
  18                  clear => sub { ++$c[3] },
  19                  free  => sub { ++$c[4] };
  20 ok(check(), 'hash : create wizard');
  21
  22 my %n = map { $_ => int rand 1000 } qw/foo bar baz qux/;
  23 my %a = %n;
  24
  25 cast %a, $wiz;
  26 ok(check(), 'hash : cast');
  27
  28 my $b = $a{foo};
  29 ok(check(), 'hash : assign element to');
  30
  31 my %b = %a;
  32 ok(check(), 'hash : assign to');
  33
  34 $b = "X%{a}Y";
  35 ok(check(), 'hash : interpolate');
  36
  37 $b = \%a;
  38 ok(check(), 'hash : reference');
  39
  40 my @b = @a{qw/bar qux/};
  41 ok(check(), 'hash : slice');
  42
  43 %a = map { $_ => 1 } qw/a b d/;
  44 ++$x[3];
  45 ok(check(), 'hash : assign');
  46
  47 $a{d} = 2;
  48 ok(check(), 'hash : assign old element');
  49
  50 $a{c} = 3;
  51 ok(check(), 'hash : assign new element');
  52
  53 $b = %a;
  54 ok(check(), 'hash : buckets');
  55
  56 @b = keys %a;
  57 ok(check(), 'hash : keys');
  58
  59 @b = values %a;
  60 ok(check(), 'hash : values');
  61
  62 while (my ($k, $v) = each %a) { }
  63 ok(check(), 'hash : each');
  64
  65 {
  66  my %b = %n;
  67  cast %b, $wiz;
  68 }
  69 ++$x[4];
  70 ok(check(), 'hash : scope end');
  71
  72 undef %a;
  73 ++$x[3];
  74 ok(check(), 'hash : undef');
  75
  76 dispell %a, $wiz;
  77 ok(check(), 'hash : dispel');