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