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/;
   9
  10 my @c = (0) x 12;
  11 my @x = (0) x 12;
  12
  13 sub check {
  14  for (0 .. 11) { 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                  copy  => sub { ++$c[5] },
  24                  dup   => sub { ++$c[6] },
  25                  local => sub { ++$c[7] },
  26                  fetch => sub { ++$c[8] },
  27                  store => sub { ++$c[9] },
  28                  'exists' => sub { ++$c[10] },
  29                  'delete' => sub { ++$c[11] };
  30 ok(check(), 'array : create wizard');
  31
  32 my @n = map { int rand 1000 } 1 .. 5;
  33 my @a = @n;
  34
  35 cast @a, $wiz;
  36 ok(check(), 'array : cast');
  37
  38 my $b = $a[2];
  39 ok(check(), 'array : assign element to');
  40
  41 my @b = @a;
  42 ++$x[2];
  43 ok(check(), 'array : assign to');
  44
  45 $b = "X@{a}Y";
  46 ++$x[2];
  47 ok(check(), 'array : interpolate');
  48
  49 $b = \@a;
  50 ok(check(), 'array : reference');
  51
  52 @b = @a[2 .. 4];
  53 ok(check(), 'array : slice');
  54
  55 @a = qw/a b d/;
  56 $x[1] += 3; ++$x[3];
  57 ok(check(), 'array : assign');
  58
  59 $a[2] = 'c';
  60 ok(check(), 'array : assign old element');
  61
  62 $a[3] = 'd';
  63 ++$x[1];
  64 ok(check(), 'array : assign new element');
  65
  66 push @a, 'x';
  67 ++$x[1]; ++$x[2] unless $^V && $^V gt 5.9.2; # since 5.9.3
  68 ok(check(), 'array : push');
  69
  70 pop @a;
  71 ++$x[1]; ++$x[2];
  72 ok(check(), 'array : pop');
  73
  74 unshift @a, 'x';
  75 ++$x[1]; ++$x[2];
  76 ok(check(), 'array : unshift');
  77
  78 shift @a;
  79 ++$x[1]; ++$x[2];
  80 ok(check(), 'array : shift');
  81
  82 $b = @a;
  83 ++$x[2];
  84 ok(check(), 'array : length');
  85
  86 @a = map ord, @a;
  87 $x[1] += 4; ++$x[2]; ++$x[3];
  88 ok(check(), 'array : map');
  89
  90 @b = grep { defined && $_ >= ord('b') } @a;
  91 ++$x[2];
  92 ok(check(), 'array : grep');
  93
  94 for (@a) { }
  95 $x[2] += 5;
  96 ok(check(), 'array : for');
  97
  98 {
  99  my @b = @n;
 100  cast @b, $wiz;
 101 }
 102 ++$x[4];
 103 ok(check(), 'array : scope end');
 104
 105 undef @a;
 106 ++$x[3] if $^V && $^V gt 5.9.4; # since 5.9.5 - see #43357
 107 ok(check(), 'array : undef');
 108
 109 dispell @a, $wiz;
 110 ok(check(), 'array : dispel');