t/30-scalar.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 13;
   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('scalar : create wizard');
  33
  34 my $n = int rand 1000;
  35 my $a = $n;
  36
  37 cast $a, $wiz;
  38 check('scalar : cast');
  39
  40 my $b = $a;
  41 ++$x[0];
  42 check('scalar : assign to');
  43
  44 $b = "X${a}Y";
  45 ++$x[0];
  46 check('scalar : interpolate');
  47
  48 $b = \$a;
  49 check('scalar : reference');
  50
  51 $a = 123;
  52 ++$x[1];
  53 check('scalar : assign');
  54
  55 ++$a;
  56 ++$x[0]; ++$x[1];
  57 check('scalar : increment');
  58
  59 --$a;
  60 ++$x[0]; ++$x[1];
  61 check('scalar : decrement');
  62
  63 $a *= 1.5;
  64 ++$x[0]; ++$x[1];
  65 check('scalar : multiply');
  66
  67 $a /= 1.5;
  68 ++$x[0]; ++$x[1];
  69 check('scalar : divide');
  70
  71 {
  72  my $b = $n;
  73  cast $b, $wiz;
  74 }
  75 ++$x[4];
  76 check('scalar : scope end');
  77
  78 undef $a;
  79 ++$x[1];
  80 check('scalar : undef');
  81
  82 dispell $a, $wiz;
  83 check('scalar : dispell');