X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2Flib%2FVariable%2FMagic%2FTestWatcher.pm;h=a8499226e06232d82de7b5ca2d67492b4149e143;hb=20cffa3667611284cad478382155c3582754240b;hp=a8b5297d11ece058169c62ad8e76c943762080ab;hpb=391dfbafe931a004b429a0f13ca58b4d10f60887;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/lib/Variable/Magic/TestWatcher.pm b/t/lib/Variable/Magic/TestWatcher.pm index a8b5297..a849922 100644 --- a/t/lib/Variable/Magic/TestWatcher.pm +++ b/t/lib/Variable/Magic/TestWatcher.pm @@ -5,12 +5,12 @@ use warnings; use Test::More; -use Carp qw/croak/; -use Variable::Magic qw/wizard/; +use Carp qw; +use Variable::Magic qw; -use base qw/Exporter/; +use base qw; -our @EXPORT = qw/init check/; +our @EXPORT = qw; sub _types { my $t = shift; @@ -24,10 +24,11 @@ sub _types { 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; + local $@; %mg = (); $wiz = eval 'wizard ' . join(', ', map { "$_ => sub { \$mg{$_}++;" . ($_ eq 'len' ? '$_[2]' : '0') . '}' @@ -37,16 +38,25 @@ sub init ($;$) { return $wiz; } -sub check (&;$$) { +sub watch (&;$$) { my $code = shift; my $exp = _types shift; my $desc = shift; + my $want = wantarray; + my @ret; local %mg = (); local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1; - my @ret = eval { $code->() }; + local $@; + if (not defined $want) { # void context + eval { $code->() }; + } elsif (not $want) { # scalar context + $ret[0] = eval { $code->() }; + } else { + @ret = eval { $code->() }; + } is $@, '', $prefix . $desc . ' doesn\'t croak'; is_deeply \%mg, $exp, $prefix . $desc . ' triggers magic correctly'; - return @ret; + return $want ? @ret : $ret[0]; } our $mg_end;