t/34-glob.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 eval "use Symbol qw/gensym/";
   9 if ($@) {
  10  plan skip_all => "Symbol::gensym required for testing magic for globs";
  11 } else {
  12  plan tests => 7;
  13 }
  14
  15 use Variable::Magic qw/wizard cast dispell/;
  16
  17 my @c = (0) x 12;
  18 my @x = (0) x 12;
  19
  20 sub check {
  21  is join(':', map { (defined) ? $_ : 'u' } @c[0 .. 11]),
  22     join(':', map { (defined) ? $_ : 'u' } @x[0 .. 11]),
  23     $_[0];
  24 }
  25
  26 my $i = -1;
  27 my $wiz = wizard get   => sub { ++$c[0] },
  28                  set   => sub { ++$c[1] },
  29                  len   => sub { ++$c[2] },
  30                  clear => sub { ++$c[3] },
  31                  free  => sub { ++$c[4] },
  32                  copy  => sub { ++$c[5] },
  33                  dup   => sub { ++$c[6] },
  34                  local => sub { ++$c[7] },
  35                  fetch => sub { ++$c[8] },
  36                  store => sub { ++$c[9] },
  37                  'exists' => sub { ++$c[10] },
  38                  'delete' => sub { ++$c[11] };
  39 check('glob : create wizard');
  40
  41 local *a = gensym();
  42
  43 cast *a, $wiz;
  44 check('glob : cast');
  45
  46 local *b = *a;
  47 check('glob : assign to');
  48
  49 *a = gensym();
  50 ++$x[1];
  51 check('glob : assign');
  52
  53 {
  54  local *b = gensym();
  55  cast *b, $wiz;
  56 }
  57 check('glob : scope end');
  58
  59 undef *a;
  60 check('glob : undef');
  61
  62 dispell *a, $wiz;
  63 check('glob : dispell');