t/31-array.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 24;
   7
   8 use Variable::Magic qw/wizard cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID 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 (void)');
  70
  71 $b = push @a, 'x';
  72 ++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_PUSH_NOLEN;
  73 check('array : push (scalar)');
  74
  75 pop @a;
  76 ++$x[1]; ++$x[2];
  77 check('array : pop');
  78
  79 unshift @a, 'x';
  80 ++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID;
  81 check('array : unshift (void)');
  82
  83 $b = unshift @a, 'x';
  84 ++$x[1]; ++$x[2];
  85 check('array : unshift (scalar)');
  86
  87 shift @a;
  88 ++$x[1]; ++$x[2];
  89 check('array : shift');
  90
  91 $b = @a;
  92 ++$x[2];
  93 check('array : length @');
  94
  95 $b = $#a;
  96 ++$x[2];
  97 check('array : length $#');
  98
  99 @a = map ord, @a;
 100 $x[1] += 6; ++$x[2]; ++$x[3];
 101 check('array : map');
 102
 103 @b = grep { defined && $_ >= ord('b') } @a;
 104 ++$x[2];
 105 check('array : grep');
 106
 107 for (@a) { }
 108 $x[2] += 7;
 109 check('array : for');
 110
 111 {
 112  my @b = @n;
 113  cast @b, $wiz;
 114 }
 115 ++$x[4];
 116 check('array : scope end');
 117
 118 undef @a;
 119 ++$x[3] if VMG_COMPAT_ARRAY_UNDEF_CLEAR;
 120 check('array : undef');
 121
 122 dispell @a, $wiz;
 123 check('array : dispel');