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