t/33-code.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 10;
   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  is join(':', map { (defined) ? $_ : 'u' } @c[0 .. 11]),
  15     join(':', map { (defined) ? $_ : 'u' } @x[0 .. 11]),
  16     $_[0];
  17 }
  18
  19 my $i = -1;
  20 my $wiz = wizard get   => sub { ++$c[0] },
  21                  set   => sub { ++$c[1] },
  22                  len   => sub { ++$c[2] },
  23                  clear => sub { ++$c[3] },
  24                  free  => sub { ++$c[4] },
  25                  copy  => sub { ++$c[5] },
  26                  dup   => sub { ++$c[6] },
  27                  local => sub { ++$c[7] },
  28                  fetch => sub { ++$c[8] },
  29                  store => sub { ++$c[9] },
  30                  'exists' => sub { ++$c[10] },
  31                  'delete' => sub { ++$c[11] };
  32 check('code : create wizard');
  33
  34 my $x = 0;
  35 my $n = sub { ++$x };
  36 my $a = $n;
  37
  38 cast $a, $wiz;
  39 check('code : cast');
  40
  41 my $b = $a;
  42 ++$x[0];
  43 check('code : assign to');
  44
  45 $b = "X${a}Y";
  46 ++$x[0];
  47 check('code : interpolate');
  48
  49 $b = \$a;
  50 check('code : reference');
  51
  52 $a = $n;
  53 ++$x[1];
  54 check('code : assign');
  55
  56 $a->();
  57 check('code : call');
  58
  59 {
  60  my $b = $n;
  61  cast $b, $wiz;
  62 }
  63 ++$x[4];
  64 check('code : scope end');
  65
  66 undef $a;
  67 ++$x[1];
  68 check('code : undef');
  69
  70 dispell $a, $wiz;
  71 check('code : dispell');