1#!perl -T
2
3use strict;
4use warnings;
5
6use Test::More tests => 2 * 12 + 11 + 1;
7
8use Variable::Magic qw/cast dispell/;
9
10use lib 't/lib';
11use Variable::Magic::TestWatcher;
12
13my $wiz = init_watcher
14        [ qw/get set len clear free copy dup local fetch store exists delete/ ],
15        'code';
16
17my $x = 0;
18sub hlagh { ++$x };
19
20watch { cast &hlagh, $wiz } { }, 'cast';
21is $x, 0, 'code: cast didn\'t called code';
22
23watch { hlagh() } { }, 'call without arguments';
24is $x, 1, 'code: call without arguments succeeded';
25
26watch { hlagh(1, 2, 3) } { }, 'call with arguments';
27is $x, 2, 'code: call with arguments succeeded';
28
29watch { undef *hlagh } { free => 1 }, 'undef symbol table entry';
30is $x, 2, 'code: undef symbol table entry didn\'t call code';
31
32my $y = 0;
33watch { *hlagh = sub { ++$y } } { }, 'redefining sub';
34
35watch { cast &hlagh, $wiz } { }, 're-cast';
36is $y, 0, 'code: re-cast didn\'t called code';
37
38my ($r) = watch { \&hlagh } { }, 'reference';
39is $y, 0, 'code: reference didn\'t called code';
40
41watch { $r->() } { }, 'call reference';
42is $y, 1, 'code: call reference succeeded';
43is $x, 2, 'code: call reference didn\'t called the previous code';
44
45my $z = 0;
46watch {
47 no warnings 'redefine';
48 *hlagh = sub { ++$z }
49} { }, 'redefining sub 2';
50
51watch { hlagh() } { }, 'call without arguments 2';
52is $z, 1, 'code: call without arguments 2 succeeded';
53is $y, 1, 'code: call without arguments 2 didn\'t called the previous code';
54
55watch { dispell &hlagh, $wiz } { }, 'dispell';
56is $z, 1, 'code: dispell didn\'t called code';
57
58$Variable::Magic::TestWatcher::mg_end = { free => 1 };
59