use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init [ qw/fetch store/ ], 'huf';
+my $wiz = init_watcher [ qw/fetch store/ ], 'huf';
ok defined($wiz), 'huf: wizard with uvar is defined';
is ref($wiz), 'SCALAR', 'huf: wizard with uvar is a scalar ref';
bless $obj, 'Variable::Magic::Test::Mock';
$h{$obj} = 5;
-my ($res) = check { cast %h, $wiz } { }, 'cast uvar magic on fieldhash';
+my ($res) = watch { cast %h, $wiz } { }, 'cast uvar magic on fieldhash';
ok $res, 'huf: cast uvar magic on fieldhash succeeded';
-my ($s) = check { $h{$obj} } { fetch => 1 }, 'fetch on magical fieldhash';
+my ($s) = watch { $h{$obj} } { fetch => 1 }, 'fetch on magical fieldhash';
is $s, 5, 'huf: fetch on magical fieldhash succeeded';
-check { $h{$obj} = 7 } { store => 1 }, 'store on magical fieldhash';
+watch { $h{$obj} = 7 } { store => 1 }, 'store on magical fieldhash';
is $h{$obj}, 7, 'huf: store on magical fieldhash succeeded';
-($res) = check { dispell %h, $wiz } { }, 'dispell uvar magic on fieldhash';
+($res) = watch { dispell %h, $wiz } { }, 'dispell uvar magic on fieldhash';
ok $res, 'huf: dispell uvar magic on fieldhash succeeded';
$h{$obj} = 11;
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init 'get', 'get';
+my $wiz = init_watcher 'get', 'get';
my $n = int rand 1000;
my $a = $n;
-check { cast $a, $wiz } { }, 'cast';
+watch { cast $a, $wiz } { }, 'cast';
my $b;
# $b has to be set inside the block for the test to pass on 5.8.3 and lower
-check { $b = $a } { get => 1 }, 'assign to';
+watch { $b = $a } { get => 1 }, 'assign to';
is $b, $n, 'get: assign to correctly';
-$b = check { "X${a}Y" } { get => 1 }, 'interpolate';
+$b = watch { "X${a}Y" } { get => 1 }, 'interpolate';
is $b, "X${n}Y", 'get: interpolate correctly';
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init 'set', 'set';
+my $wiz = init_watcher 'set', 'set';
my $a = 0;
-check { cast $a, $wiz } { }, 'cast';
+watch { cast $a, $wiz } { }, 'cast';
my $n = int rand 1000;
-check { $a = $n } { set => 1 }, 'assign';
+watch { $a = $n } { set => 1 }, 'assign';
is $a, $n, 'set: assign correctly';
-check { ++$a } { set => 1 }, 'increment';
+watch { ++$a } { set => 1 }, 'increment';
is $a, $n + 1, 'set: increment correctly';
-check { --$a } { set => 1 }, 'decrement';
+watch { --$a } { set => 1 }, 'decrement';
is $a, $n, 'set: decrement correctly';
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init 'clear', 'clear';
+my $wiz = init_watcher 'clear', 'clear';
my @a = qw/a b c/;
-check { cast @a, $wiz } { }, 'cast array';
+watch { cast @a, $wiz } { }, 'cast array';
-check { @a = () } { clear => 1 }, 'clear array';
+watch { @a = () } { clear => 1 }, 'clear array';
is_deeply \@a, [ ], 'clear: clear array correctly';
my %h = (foo => 1, bar => 2);
-check { cast %h, $wiz } { }, 'cast hash';
+watch { cast %h, $wiz } { }, 'cast hash';
-check { %h = () } { clear => 1 }, 'clear hash';
+watch { %h = () } { clear => 1 }, 'clear hash';
is_deeply \%h, { }, 'clear: clear hash correctly';
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init 'free', 'free';
+my $wiz = init_watcher 'free', 'free';
my $n = int rand 1000;
-check {
+watch {
my $a = $n;
- check { cast $a, $wiz } { }, 'cast';
+ watch { cast $a, $wiz } { }, 'cast';
} { free => 1 }, 'deletion at the end of the scope';
my $a = $n;
-check { cast $a, $wiz } { }, 'cast 2';
-check { undef $a } { }, 'explicit deletion with undef()';
+watch { cast $a, $wiz } { }, 'cast 2';
+watch { undef $a } { }, 'explicit deletion with undef()';
$Variable::Magic::TestWatcher::mg_end = { free => 1 };
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init 'copy', 'copy';
+my $wiz = init_watcher 'copy', 'copy';
SKIP: {
eval "use Tie::Array";
tie my @a, 'Tie::StdArray';
@a = (1 .. 10);
- my $res = check { cast @a, $wiz } { }, 'cast on tied array';
+ my $res = watch { cast @a, $wiz } { }, 'cast on tied array';
ok $res, 'copy: cast on tied array succeeded';
- check { $a[3] = 13 } { copy => 1 }, 'tied array store';
+ watch { $a[3] = 13 } { copy => 1 }, 'tied array store';
- my $s = check { $a[3] } { copy => 1 }, 'tied array fetch';
+ my $s = watch { $a[3] } { copy => 1 }, 'tied array fetch';
is $s, 13, 'copy: tied array fetch correctly';
- $s = check { exists $a[3] } { copy => 1 }, 'tied array exists';
+ $s = watch { exists $a[3] } { copy => 1 }, 'tied array exists';
ok $s, 'copy: tied array exists correctly';
- check { undef @a } { }, 'tied array undef';
+ watch { undef @a } { }, 'tied array undef';
}
SKIP: {
tie my %h, 'Tie::StdHash';
%h = (a => 1, b => 2, c => 3);
- my $res = check { cast %h, $wiz } { }, 'cast on tied hash';
+ my $res = watch { cast %h, $wiz } { }, 'cast on tied hash';
ok $res, 'copy: cast on tied hash succeeded';
- check { $h{b} = 7 } { copy => 1 }, 'tied hash store';
+ watch { $h{b} = 7 } { copy => 1 }, 'tied hash store';
- my $s = check { $h{c} } { copy => 1 }, 'tied hash fetch';
+ my $s = watch { $h{c} } { copy => 1 }, 'tied hash fetch';
is $s, 3, 'copy: tied hash fetch correctly';
- $s = check { exists $h{a} } { copy => 1 }, 'tied hash exists';
+ $s = watch { exists $h{a} } { copy => 1 }, 'tied hash exists';
ok $s, 'copy: tied hash exists correctly';
- $s = check { delete $h{b} } { copy => 1 }, 'tied hash delete';
+ $s = watch { delete $h{b} } { copy => 1 }, 'tied hash delete';
is $s, 7, 'copy: tied hash delete correctly';
- check { my ($k, $v) = each %h } { copy => 1 }, 'tied hash each';
+ watch { my ($k, $v) = each %h } { copy => 1 }, 'tied hash each';
- my @k = check { keys %h } { }, 'tied hash keys';
+ my @k = watch { keys %h } { }, 'tied hash keys';
is_deeply [ sort @k ], [ qw/a c/ ], 'copy: tied hash keys correctly';
- my @v = check { values %h } { copy => 2 }, 'tied hash values';
+ my @v = watch { values %h } { copy => 2 }, 'tied hash values';
is_deeply [ sort { $a <=> $b } @v ], [ 1, 3 ], 'copy: tied hash values correctly';
- check { undef %h } { }, 'tied hash undef';
+ watch { undef %h } { }, 'tied hash undef';
}
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init 'local', 'local';
+my $wiz = init_watcher 'local', 'local';
our $a = int rand 1000;
-my $res = check { cast $a, $wiz } { }, 'cast';
+my $res = watch { cast $a, $wiz } { }, 'cast';
ok $res, 'local: cast succeeded';
-check { local $a } { local => 1 }, 'localized';
+watch { local $a } { local => 1 }, 'localized';
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init [ qw/fetch store exists delete/ ], 'uvar';
+my $wiz = init_watcher [ qw/fetch store exists delete/ ], 'uvar';
my %h = (a => 1, b => 2, c => 3);
-my $res = check { cast %h, $wiz } { }, 'cast';
+my $res = watch { cast %h, $wiz } { }, 'cast';
ok $res, 'uvar: cast succeeded';
-my $x = check { $h{a} } { fetch => 1 }, 'fetch directly';
+my $x = watch { $h{a} } { fetch => 1 }, 'fetch directly';
is $x, 1, 'uvar: fetch directly correctly';
-$x = check { "$h{b}" } { fetch => 1 }, 'fetch by interpolation';
+$x = watch { "$h{b}" } { fetch => 1 }, 'fetch by interpolation';
is $x, 2, 'uvar: fetch by interpolation correctly';
-check { $h{c} = 4 } { store => 1 }, 'store directly';
+watch { $h{c} = 4 } { store => 1 }, 'store directly';
-$x = check { $h{c} = 5 } { store => 1 }, 'fetch and store';
+$x = watch { $h{c} = 5 } { store => 1 }, 'fetch and store';
is $x, 5, 'uvar: fetch and store correctly';
-$x = check { exists $h{c} } { exists => 1 }, 'exists';
+$x = watch { exists $h{c} } { exists => 1 }, 'exists';
ok $x, 'uvar: exists correctly';
-$x = check { delete $h{c} } { delete => 1 }, 'delete existing key';
+$x = watch { delete $h{c} } { delete => 1 }, 'delete existing key';
is $x, 5, 'uvar: delete existing key correctly';
-$x = check { delete $h{z} } { delete => 1 }, 'delete non-existing key';
+$x = watch { delete $h{z} } { delete => 1 }, 'delete non-existing key';
ok !defined $x, 'uvar: delete non-existing key correctly';
my $wiz2 = wizard get => sub { 0 };
cast %h, $wiz2;
-$x = check { $h{a} } { fetch => 1 }, 'fetch directly with also non uvar magic';
+$x = watch { $h{a} } { fetch => 1 }, 'fetch directly with also non uvar magic';
is $x, 1, 'uvar: fetch directly with also non uvar magic correctly';
SKIP: {
tie my %h, 'Tie::StdHash';
%h = (x => 7, y => 8);
- $res = check { cast %h, $wiz } { }, 'cast on tied hash';
+ $res = watch { cast %h, $wiz } { }, 'cast on tied hash';
ok $res, 'uvar: cast on tied hash succeeded';
- $x = check { $h{x} } { fetch => 1 }, 'fetch on tied hash';
+ $x = watch { $h{x} } { fetch => 1 }, 'fetch on tied hash';
is $x, 7, 'uvar: fetch on tied hash succeeded';
- check { $h{x} = 9 } { store => 1 }, 'store on tied hash';
+ watch { $h{x} = 9 } { store => 1 }, 'store on tied hash';
- $x = check { exists $h{x} } { exists => 1 }, 'exists on tied hash';
+ $x = watch { exists $h{x} } { exists => 1 }, 'exists on tied hash';
ok $x, 'uvar: exists on tied hash succeeded';
- $x = check { delete $h{x} } { delete => 1 }, 'delete on tied hash';
+ $x = watch { delete $h{x} } { delete => 1 }, 'delete on tied hash';
is $x, 9, 'uvar: delete on tied hash succeeded';
}
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init
+my $wiz = init_watcher
[ qw/get set len clear free copy dup local fetch store exists delete/ ],
'scalar';
my $n = int rand 1000;
my $a = $n;
-check { cast $a, $wiz } { }, 'cast';
+watch { cast $a, $wiz } { }, 'cast';
my $b;
# $b has to be set inside the block for the test to pass on 5.8.3 and lower
-check { $b = $a } { get => 1 }, 'assign to';
+watch { $b = $a } { get => 1 }, 'assign to';
is $b, $n, 'scalar: assign to correctly';
-$b = check { "X${a}Y" } { get => 1 }, 'interpolate';
+$b = watch { "X${a}Y" } { get => 1 }, 'interpolate';
is $b, "X${n}Y", 'scalar: interpolate correctly';
-$b = check { \$a } { }, 'reference';
+$b = watch { \$a } { }, 'reference';
-check { $a = 123; () } { set => 1 }, 'assign to';
+watch { $a = 123; () } { set => 1 }, 'assign to';
-check { ++$a; () } { get => 1, set => 1 }, 'increment';
+watch { ++$a; () } { get => 1, set => 1 }, 'increment';
-check { --$a; () } { get => 1, set => 1 }, 'decrement';
+watch { --$a; () } { get => 1, set => 1 }, 'decrement';
-check { $a *= 1.5; () } { get => 1, set => 1 }, 'multiply in place';
+watch { $a *= 1.5; () } { get => 1, set => 1 }, 'multiply in place';
-check { $a /= 1.5; () } { get => 1, set => 1 }, 'divide in place';
+watch { $a /= 1.5; () } { get => 1, set => 1 }, 'divide in place';
-check {
+watch {
my $b = $n;
- check { cast $b, $wiz } { }, 'cast 2';
+ watch { cast $b, $wiz } { }, 'cast 2';
} { free => 1 }, 'scope end';
-check { undef $a } { set => 1 }, 'undef';
+watch { undef $a } { set => 1 }, 'undef';
-check { dispell $a, $wiz } { }, 'dispell';
+watch { dispell $a, $wiz } { }, 'dispell';
# Array element
my @a = (7, 8, 9);
-check { cast $a[1], $wiz } { }, 'array element: cast';
+watch { cast $a[1], $wiz } { }, 'array element: cast';
-check { $a[1] = 6; () } { set => 1 }, 'array element: set';
+watch { $a[1] = 6; () } { set => 1 }, 'array element: set';
-$b = check { $a[1] } { get => 1 }, 'array element: get';
+$b = watch { $a[1] } { get => 1 }, 'array element: get';
is $b, 6, 'scalar: array element: get correctly';
-check { $a[0] = 5 } { }, 'array element: set other';
+watch { $a[0] = 5 } { }, 'array element: set other';
-$b = check { $a[2] } { }, 'array element: get other';
+$b = watch { $a[2] } { }, 'array element: get other';
is $b, 9, 'scalar: array element: get other correctly';
-$b = check { exists $a[1] } { }, 'array element: exists';
+$b = watch { exists $a[1] } { }, 'array element: exists';
is $b, 1, 'scalar: array element: exists correctly';
# $b has to be set inside the block for the test to pass on 5.8.3 and lower
-check { $b = delete $a[1] } { get => 1, free => ($] > 5.008005 ? 1 : 0) }, 'array element: delete';
+watch { $b = delete $a[1] } { get => 1, free => ($] > 5.008005 ? 1 : 0) }, 'array element: delete';
is $b, 6, 'scalar: array element: delete correctly';
-check { $a[1] = 4 } { }, 'array element: set after delete';
+watch { $a[1] = 4 } { }, 'array element: set after delete';
# Hash element
my %h = (a => 7, b => 8);
-check { cast $h{b}, $wiz } { }, 'hash element: cast';
+watch { cast $h{b}, $wiz } { }, 'hash element: cast';
-check { $h{b} = 6; () } { set => 1 }, 'hash element: set';
+watch { $h{b} = 6; () } { set => 1 }, 'hash element: set';
-$b = check { $h{b} } { get => 1 }, 'hash element: get';
+$b = watch { $h{b} } { get => 1 }, 'hash element: get';
is $b, 6, 'scalar: hash element: get correctly';
-check { $h{a} = 5 } { }, 'hash element: set other';
+watch { $h{a} = 5 } { }, 'hash element: set other';
-$b = check { $h{a} } { }, 'hash element: get other';
+$b = watch { $h{a} } { }, 'hash element: get other';
is $b, 5, 'scalar: hash element: get other correctly';
-$b = check { exists $h{b} } { }, 'hash element: exists';
+$b = watch { exists $h{b} } { }, 'hash element: exists';
is $b, 1, 'scalar: hash element: exists correctly';
-$b = check { delete $h{b} } { get => 1, free => 1 }, 'hash element: delete';
+$b = watch { delete $h{b} } { get => 1, free => 1 }, 'hash element: delete';
is $b, 6, 'scalar: hash element: delete correctly';
-check { $h{b} = 4 } { }, 'hash element: set after delete';
+watch { $h{b} = 4 } { }, 'hash element: set after delete';
SKIP: {
my $SKIP;
};
is $@, '', 'cast copy magic on tied array';
- check { delete $a[0] } [ qw/get clear free/ ], 'delete from tied array';
+ watch { delete $a[0] } [ qw/get clear free/ ], 'delete from tied array';
}
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init
+my $wiz = init_watcher
[ qw/get set len clear free copy dup local fetch store exists delete/ ],
'array';
my @n = map { int rand 1000 } 1 .. 5;
my @a = @n;
-check { cast @a, $wiz } { }, 'cast';
+watch { cast @a, $wiz } { }, 'cast';
-my $b = check { $a[2] } { }, 'assign element to';
+my $b = watch { $a[2] } { }, 'assign element to';
is $b, $n[2], 'array: assign element to correctly';
-my @b = check { @a } { len => 1 }, 'assign to';
+my @b = watch { @a } { len => 1 }, 'assign to';
is_deeply \@b, \@n, 'array: assign to correctly';
-$b = check { "X@{a}Y" } { len => 1 }, 'interpolate';
+$b = watch { "X@{a}Y" } { len => 1 }, 'interpolate';
is $b, "X@{n}Y", 'array: interpolate correctly';
-$b = check { \@a } { }, 'reference';
+$b = watch { \@a } { }, 'reference';
-@b = check { @a[2 .. 4] } { }, 'slice';
+@b = watch { @a[2 .. 4] } { }, 'slice';
is_deeply \@b, [ @n[2 .. 4] ], 'array: slice correctly';
-check { @a = qw/a b d/ } { set => 3, clear => 1 }, 'assign';
+watch { @a = qw/a b d/ } { set => 3, clear => 1 }, 'assign';
-check { $a[2] = 'c' } { }, 'assign old element';
+watch { $a[2] = 'c' } { }, 'assign old element';
-check { $a[4] = 'd' } { set => 1 }, 'assign new element';
+watch { $a[4] = 'd' } { set => 1 }, 'assign new element';
-$b = check { exists $a[4] } { }, 'exists';
+$b = watch { exists $a[4] } { }, 'exists';
is $b, 1, 'array: exists correctly';
-$b = check { delete $a[4] } { set => 1 }, 'delete';
+$b = watch { delete $a[4] } { set => 1 }, 'delete';
is $b, 'd', 'array: delete correctly';
-$b = check { @a } { len => 1 }, 'length @';
+$b = watch { @a } { len => 1 }, 'length @';
is $b, 3, 'array: length @ correctly';
# $b has to be set inside the block for the test to pass on 5.8.3 and lower
-check { $b = $#a } { len => 1 }, 'length $#';
+watch { $b = $#a } { len => 1 }, 'length $#';
is $b, 2, 'array: length $# correctly';
-check { push @a, 'x'; () }
+watch { push @a, 'x'; () }
{ set => 1, (len => 1) x !VMG_COMPAT_ARRAY_PUSH_NOLEN },'push (void)';
-$b = check { push @a, 'y' }
+$b = watch { push @a, 'y' }
{ set => 1, (len => 1) x !VMG_COMPAT_ARRAY_PUSH_NOLEN }, 'push (scalar)';
is $b, 5, 'array: push (scalar) correctly';
-$b = check { pop @a } { set => 1, len => 1 }, 'pop';
+$b = watch { pop @a } { set => 1, len => 1 }, 'pop';
is $b, 'y', 'array: pop correctly';
-check { unshift @a, 'z'; () }
+watch { unshift @a, 'z'; () }
{ set => 1, (len => 1) x !VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID },
'unshift (void)';
-$b = check { unshift @a, 't' } { set => 1, len => 1 }, 'unshift (scalar)';
+$b = watch { unshift @a, 't' } { set => 1, len => 1 }, 'unshift (scalar)';
is $b, 6, 'unshift (scalar) correctly';
-$b = check { shift @a } { set => 1, len => 1 }, 'shift';
+$b = watch { shift @a } { set => 1, len => 1 }, 'shift';
is $b, 't', 'array: shift correctly';
-check { my $i; @a = map ++$i, @a; () } { set => 5, len => 1, clear => 1}, 'map';
+watch { my $i; @a = map ++$i, @a; () } { set => 5, len => 1, clear => 1}, 'map';
-@b = check { grep { $_ >= 4 } @a } { len => 1 }, 'grep';
+@b = watch { grep { $_ >= 4 } @a } { len => 1 }, 'grep';
is_deeply \@b, [ 4 .. 5 ], 'array: grep correctly';
-check { 1 for @a } { len => 5 + 1 }, 'for';
+watch { 1 for @a } { len => 5 + 1 }, 'for';
-check {
+watch {
my @b = @n;
- check { cast @b, $wiz } { }, 'cast 2';
+ watch { cast @b, $wiz } { }, 'cast 2';
} { free => 1 }, 'scope end';
-check { undef @a } +{ (clear => 1) x VMG_COMPAT_ARRAY_UNDEF_CLEAR }, 'undef';
+watch { undef @a } +{ (clear => 1) x VMG_COMPAT_ARRAY_UNDEF_CLEAR }, 'undef';
-check { dispell @a, $wiz } { }, 'dispell';
+watch { dispell @a, $wiz } { }, 'dispell';
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init
+my $wiz = init_watcher
[ qw/get set len clear free copy dup local fetch store exists delete/ ],
'hash';
my %n = map { $_ => int rand 1000 } qw/foo bar baz qux/;
my %h = %n;
-check { cast %h, $wiz } { }, 'cast';
+watch { cast %h, $wiz } { }, 'cast';
-my $s = check { $h{foo} } +{ (fetch => 1) x VMG_UVAR },
+my $s = watch { $h{foo} } +{ (fetch => 1) x VMG_UVAR },
'assign element to';
is $s, $n{foo}, 'hash: assign element to correctly';
for (1 .. 2) {
- $s = check { exists $h{foo} } +{ (exists => 1) x VMG_UVAR }, "exists ($_)";
+ $s = watch { exists $h{foo} } +{ (exists => 1) x VMG_UVAR }, "exists ($_)";
ok $s, "hash: exists correctly ($_)";
}
my %b;
-check { %b = %h } { }, 'assign to';
+watch { %b = %h } { }, 'assign to';
is_deeply \%b, \%n, 'hash: assign to correctly';
-$s = check { \%h } { }, 'reference';
+$s = watch { \%h } { }, 'reference';
-my @b = check { @h{qw/bar qux/} }
+my @b = watch { @h{qw/bar qux/} }
+{ (fetch => 2) x VMG_UVAR }, 'slice';
is_deeply \@b, [ @n{qw/bar qux/} ], 'hash: slice correctly';
-check { %h = () } { clear => 1 }, 'empty in list context';
+watch { %h = () } { clear => 1 }, 'empty in list context';
-check { %h = (a => 1, d => 3); () }
+watch { %h = (a => 1, d => 3); () }
+{ (store => 2, copy => 2) x VMG_UVAR, clear => 1 },
'assign from list in void context';
-check { %h = map { $_ => 1 } qw/a b d/; }
+watch { %h = map { $_ => 1 } qw/a b d/; }
+{ (exists => 3, store => 3, copy => 3) x VMG_UVAR, clear => 1 },
'assign from map in list context';
-check { $h{d} = 2; () } +{ (store => 1) x VMG_UVAR },
+watch { $h{d} = 2; () } +{ (store => 1) x VMG_UVAR },
'assign old element';
-check { $h{c} = 3; () } +{ (store => 1, copy => 1) x VMG_UVAR },
+watch { $h{c} = 3; () } +{ (store => 1, copy => 1) x VMG_UVAR },
'assign new element';
-$s = check { %h } { }, 'buckets';
+$s = watch { %h } { }, 'buckets';
-@b = check { keys %h } { }, 'keys';
+@b = watch { keys %h } { }, 'keys';
is_deeply [ sort @b ], [ qw/a b c d/ ], 'hash: keys correctly';
-@b = check { values %h } { }, 'values';
+@b = watch { values %h } { }, 'values';
is_deeply [ sort { $a <=> $b } @b ], [ 1, 1, 2, 3 ], 'hash: values correctly';
-check { while (my ($k, $v) = each %h) { } } { }, 'each';
+watch { while (my ($k, $v) = each %h) { } } { }, 'each';
-check {
+watch {
my %b = %n;
- check { cast %b, $wiz } { }, 'cast 2';
+ watch { cast %b, $wiz } { }, 'cast 2';
} { free => 1 }, 'scope end';
-check { undef %h } { clear => 1 }, 'undef';
+watch { undef %h } { clear => 1 }, 'undef';
-check { dispell %h, $wiz } { }, 'dispell';
+watch { dispell %h, $wiz } { }, 'dispell';
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init
+my $wiz = init_watcher
[ qw/get set len clear free copy dup local fetch store exists delete/ ],
'code';
my $x = 0;
sub hlagh { ++$x };
-check { cast &hlagh, $wiz } { }, 'cast';
+watch { cast &hlagh, $wiz } { }, 'cast';
is $x, 0, 'code: cast didn\'t called code';
-check { hlagh() } { }, 'call without arguments';
+watch { hlagh() } { }, 'call without arguments';
is $x, 1, 'code: call without arguments succeeded';
-check { hlagh(1, 2, 3) } { }, 'call with arguments';
+watch { hlagh(1, 2, 3) } { }, 'call with arguments';
is $x, 2, 'code: call with arguments succeeded';
-check { undef *hlagh } { free => 1 }, 'undef symbol table entry';
+watch { undef *hlagh } { free => 1 }, 'undef symbol table entry';
is $x, 2, 'code: undef symbol table entry didn\'t call code';
my $y = 0;
-check { *hlagh = sub { ++$y } } { }, 'redefining sub';
+watch { *hlagh = sub { ++$y } } { }, 'redefining sub';
-check { cast &hlagh, $wiz } { }, 're-cast';
+watch { cast &hlagh, $wiz } { }, 're-cast';
is $y, 0, 'code: re-cast didn\'t called code';
-my ($r) = check { \&hlagh } { }, 'reference';
+my ($r) = watch { \&hlagh } { }, 'reference';
is $y, 0, 'code: reference didn\'t called code';
-check { $r->() } { }, 'call reference';
+watch { $r->() } { }, 'call reference';
is $y, 1, 'code: call reference succeeded';
is $x, 2, 'code: call reference didn\'t called the previous code';
my $z = 0;
-check {
+watch {
no warnings 'redefine';
*hlagh = sub { ++$z }
} { }, 'redefining sub 2';
-check { hlagh() } { }, 'call without arguments 2';
+watch { hlagh() } { }, 'call without arguments 2';
is $z, 1, 'code: call without arguments 2 succeeded';
is $y, 1, 'code: call without arguments 2 didn\'t called the previous code';
-check { dispell &hlagh, $wiz } { }, 'dispell';
+watch { dispell &hlagh, $wiz } { }, 'dispell';
is $z, 1, 'code: dispell didn\'t called code';
$Variable::Magic::TestWatcher::mg_end = { free => 1 };
use lib 't/lib';
use Variable::Magic::TestWatcher;
-my $wiz = init
+my $wiz = init_watcher
[ qw/get set len clear free copy dup local fetch store exists delete/ ],
'glob';
local *a = gensym();
-check { cast *a, $wiz } { }, 'cast';
+watch { cast *a, $wiz } { }, 'cast';
-check { local *b = *a } { }, 'assign to';
+watch { local *b = *a } { }, 'assign to';
-check { *a = gensym() } { set => 1 }, 'assign';
+watch { *a = gensym() } { set => 1 }, 'assign';
-check {
+watch {
local *b = gensym();
- check { cast *b, $wiz } { }, 'cast 2';
+ watch { cast *b, $wiz } { }, 'cast 2';
} { }, 'scope end';
-check { undef *a } { }, 'undef';
+watch { undef *a } { }, 'undef';
-check { dispell *a, $wiz } { }, 'dispell';
+watch { dispell *a, $wiz } { }, 'dispell';
use base qw/Exporter/;
-our @EXPORT = qw/init check/;
+our @EXPORT = qw/init_watcher watch/;
sub _types {
my $t = shift;
our ($wiz, $prefix, %mg);
-sub init ($;$) {
+sub init_watcher ($;$) {
croak 'can\'t initialize twice' if defined $wiz;
my $types = _types shift;
$prefix = (defined) ? "$_: " : '' for shift;
return $wiz;
}
-sub check (&;$$) {
+sub watch (&;$$) {
my $code = shift;
my $exp = _types shift;
my $desc = shift;
projects / perl / modules / Variable-Magic.git / commitdiff