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