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  for (0 .. 11) { return 0 unless $c[$_] == $x[$_]; }
  15  return 1;
  16 }
  17
  18 my $i = -1;
  19 my $wiz = wizard get   => sub { ++$c[0] },
  20                  set   => sub { ++$c[1] },
  21                  len   => sub { ++$c[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 ok(check(), 'code : create wizard');
  32
  33 my $x = 0;
  34 my $n = sub { ++$x };
  35 my $a = $n;
  36
  37 cast $a, $wiz;
  38 ok(check(), 'code : cast');
  39
  40 my $b = $a;
  41 ++$x[0];
  42 ok(check(), 'code : assign to');
  43
  44 $b = "X${a}Y";
  45 ++$x[0];
  46 ok(check(), 'code : interpolate');
  47
  48 $b = \$a;
  49 ok(check(), 'code : reference');
  50
  51 $a = $n;
  52 ++$x[1];
  53 ok(check(), 'code : assign');
  54
  55 $a->();
  56 ok(check(), 'code : call');
  57
  58 {
  59  my $b = $n;
  60  cast $b, $wiz;
  61 }
  62 ++$x[4];
  63 ok(check(), 'code : scope end');
  64
  65 undef $a;
  66 ++$x[1];
  67 ok(check(), 'code : undef');
  68
  69 dispell $a, $wiz;
  70 ok(check(), 'code : dispell');