t/31-array.t

   1 #!perl -T
   2
   3 use Test::More tests => 21;
   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(), 'array : create wizard');
  21
  22 my @n = map { int rand 1000 } 1 .. 5;
  23 my @a = @n;
  24
  25 cast @a, $wiz;
  26 ok(check(), 'array : cast');
  27
  28 my $b = $a[2];
  29 ok(check(), 'array : assign element to');
  30
  31 my @b = @a;
  32 ++$x[2];
  33 ok(check(), 'array : assign to');
  34
  35 $b = "X@{a}Y";
  36 ++$x[2];
  37 ok(check(), 'array : interpolate');
  38
  39 $b = \@a;
  40 ok(check(), 'array : reference');
  41
  42 @b = @a[2 .. 4];
  43 ok(check(), 'array : slice');
  44
  45 @a = qw/a b d/;
  46 $x[1] += 3; ++$x[3];
  47 ok(check(), 'array : assign');
  48
  49 $a[2] = 'c';
  50 ok(check(), 'array : assign old element');
  51
  52 $a[3] = 'd';
  53 ++$x[1];
  54 ok(check(), 'array : assign new element');
  55
  56 push @a, 'x';
  57 ++$x[1]; ++$x[2];
  58 ok(check(), 'array : push');
  59
  60 pop @a;
  61 ++$x[1]; ++$x[2];
  62 ok(check(), 'array : pop');
  63
  64 unshift @a, 'x';
  65 ++$x[1]; ++$x[2];
  66 ok(check(), 'array : unshift');
  67
  68 shift @a;
  69 ++$x[1]; ++$x[2];
  70 ok(check(), 'array : shift');
  71
  72 $b = @a;
  73 ++$x[2];
  74 ok(check(), 'array : length');
  75
  76 @a = map ord, @a;
  77 $x[1] += 4; ++$x[2]; ++$x[3];
  78 ok(check(), 'array : map');
  79
  80 @b = grep { defined && $_ >= ord('b') } @a;
  81 ++$x[2];
  82 ok(check(), 'array : grep');
  83
  84 for (@a) { }
  85 $x[2] += 5;
  86 ok(check(), 'array : for');
  87
  88 {
  89  my @b = @n;
  90 # cast @b, $wiz;
  91 }
  92 #++$x[4];
  93 ok(check(), 'array : scope end');
  94
  95 undef @a;
  96 ok(check(), 'array : undef');
  97
  98 dispell @a, $wiz;
  99 ok(check(), 'array : dispel');