]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/33-code.t
Convert t/27-local.t to the new testing framework
[perl/modules/Variable-Magic.git] / t / 33-code.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 14;
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 sub hlagh { ++$x };
36
37 cast &hlagh, $wiz;
38 check('code : cast');
39
40 hlagh();
41 check('code : call without arguments');
42 is($x, 1, 'code : call without arguments succeeded');
43
44 hlagh(1, 2, 3);
45 check('code : call with arguments');
46 is($x, 2, 'code : call with arguments succeeded');
47
48 undef *hlagh;
49 ++$x[4];
50 check('code : undef symbol table');
51 is($x, 2, 'code : undef symbol table didn\'t call');
52
53 my $y = 0;
54 *hlagh = sub { ++$y };
55
56 cast &hlagh, $wiz;
57 check('code : re-cast');
58
59 my $r = \&hlagh;
60 check('code : take reference');
61
62 $r->();
63 check('code : call reference');
64 is($y, 1, 'code : call reference succeeded');
65 is($x, 2, 'code : call reference didn\'t triggered the previous code');
66
67 dispell &hlagh, $wiz;
68 check('code : dispell');