t/32-hash.t

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