t/31-array.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 21;
   7
   8 use Variable::Magic qw/wizard cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR/;
   9
  10 my @c = (0) x 12;
  11 my @x = (0) x 12;
  12
  13 sub check {
  14  is join(':', map { (defined) ? $_ : 'u' } @c[0 .. 11]),
  15     join(':', map { (defined) ? $_ : 'u' } @x[0 .. 11]),
  16     $_[0];
  17 }
  18
  19 my $wiz = wizard get   => sub { ++$c[0] },
  20                  set   => sub { ++$c[1] },
  21                  len   => sub { ++$c[2]; $_[2] },
  22                  clear => sub { ++$c[3] },
  23                  free  => sub { ++$c[4] },
  24                  copy  => sub { ++$c[5] },
  25                  dup   => sub { ++$c[6] },
  26                  local => sub { ++$c[7] },
  27                  fetch => sub { ++$c[8] },
  28                  store => sub { ++$c[9] },
  29                  'exists' => sub { ++$c[10] },
  30                  'delete' => sub { ++$c[11] };
  31 check('array : create wizard');
  32
  33 my @n = map { int rand 1000 } 1 .. 5;
  34 my @a = @n;
  35
  36 cast @a, $wiz;
  37 check('array : cast');
  38
  39 my $b = $a[2];
  40 check('array : assign element to');
  41
  42 my @b = @a;
  43 ++$x[2];
  44 check('array : assign to');
  45
  46 $b = "X@{a}Y";
  47 ++$x[2];
  48 check('array : interpolate');
  49
  50 $b = \@a;
  51 check('array : reference');
  52
  53 @b = @a[2 .. 4];
  54 check('array : slice');
  55
  56 @a = qw/a b d/;
  57 $x[1] += 3; ++$x[3];
  58 check('array : assign');
  59
  60 $a[2] = 'c';
  61 check('array : assign old element');
  62
  63 $a[3] = 'd';
  64 ++$x[1];
  65 check('array : assign new element');
  66
  67 push @a, 'x';
  68 ++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_PUSH_NOLEN;
  69 check('array : push');
  70
  71 pop @a;
  72 ++$x[1]; ++$x[2];
  73 check('array : pop');
  74
  75 unshift @a, 'x';
  76 ++$x[1]; ++$x[2];
  77 check('array : unshift');
  78
  79 shift @a;
  80 ++$x[1]; ++$x[2];
  81 check('array : shift');
  82
  83 $b = @a;
  84 ++$x[2];
  85 check('array : length');
  86
  87 @a = map ord, @a;
  88 $x[1] += 4; ++$x[2]; ++$x[3];
  89 check('array : map');
  90
  91 @b = grep { defined && $_ >= ord('b') } @a;
  92 ++$x[2];
  93 check('array : grep');
  94
  95 for (@a) { }
  96 $x[2] += 5;
  97 check('array : for');
  98
  99 {
 100  my @b = @n;
 101  cast @b, $wiz;
 102 }
 103 ++$x[4];
 104 check('array : scope end');
 105
 106 undef @a;
 107 ++$x[3] if VMG_COMPAT_ARRAY_UNDEF_CLEAR;
 108 check('array : undef');
 109
 110 dispell @a, $wiz;
 111 check('array : dispel');