X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F34-glob.t;h=bbfbeeedff7ffb4de870d1910e7006857a4b6598;hb=2d69d033c7c2942a94751972e9f482de7c3482be;hp=76e0224ac3a21fd774dff9b94103ab46d72ceec8;hpb=14f66d40970bef63105be046a109c1a32859a8a0;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/34-glob.t b/t/34-glob.t index 76e0224..bbfbeee 100644 --- a/t/34-glob.t +++ b/t/34-glob.t @@ -9,47 +9,41 @@ eval "use Symbol qw/gensym/"; if ($@) { plan skip_all => "Symbol::gensym required for testing magic for globs"; } else { - plan tests => 7; + plan tests => 2 * 12 + 1; + defined and diag "Using Symbol $_" for $Symbol::VERSION; } -use Variable::Magic qw/wizard cast dispell/; +use Variable::Magic qw/cast dispell VMG_COMPAT_GLOB_GET/; -my @c = (0) x 5; -my @x = (0) x 5; +my %get = VMG_COMPAT_GLOB_GET ? (get => 1) : (); -sub check { - for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; } - return 1; -} +use lib 't/lib'; +use Variable::Magic::TestWatcher; -my $i = -1; -my $wiz = wizard get => sub { ++$c[0] }, - set => sub { ++$c[1] }, - len => sub { ++$c[2] }, - clear => sub { ++$c[3] }, - free => sub { ++$c[4] }; -ok(check(), 'glob : create wizard'); +my $wiz = init_watcher + [ qw/get set len clear free copy dup local fetch store exists delete/ ], + 'glob'; local *a = gensym(); -cast *a, $wiz; -ok(check(), 'glob : cast'); +watch { cast *a, $wiz } +{ }, 'cast'; + +watch { local *b = *a } +{ %get }, 'assign to'; -local *b = *a; -ok(check(), 'glob : assign to'); +watch { *a = \1 } +{ %get, set => 1 }, 'assign scalar slot'; +watch { *a = [ qw/x y/ ] } +{ %get, set => 1 }, 'assign array slot'; +watch { *a = { u => 1 } } +{ %get, set => 1 }, 'assign hash slot'; +watch { *a = sub { } } +{ %get, set => 1 }, 'assign code slot'; -*a = gensym(); -++$x[1]; -ok(check(), 'glob : assign'); +watch { *a = gensym() } +{ %get, set => 1 }, 'assign glob'; -{ +watch { local *b = gensym(); - cast *b, $wiz; -} -ok(check(), 'glob : scope end'); + watch { cast *b, $wiz } +{ }, 'cast 2'; +} +{ }, 'scope end'; + +%get = () if $] >= 5.013007; -undef *a; -ok(check(), 'glob : undef'); +watch { undef *a } +{ %get }, 'undef'; -dispell *a, $wiz; -ok(check(), 'glob : dispell'); +watch { dispell *a, $wiz } +{ %get }, 'dispell';