From: Vincent Pit <vince@profvince.com>
Date: Sun, 18 Jan 2009 23:04:39 +0000 (+0100)
Subject: Convert t/33-code.t to the new testing framework
X-Git-Tag: v0.27~5
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=582d5acf296ae639bf0bca66bfbba842b745a637;p=perl%2Fmodules%2FVariable-Magic.git

Convert t/33-code.t to the new testing framework
---

diff --git a/t/33-code.t b/t/33-code.t
index 4b9cd20..da26dc6 100644
--- a/t/33-code.t
+++ b/t/33-code.t
@@ -3,66 +3,44 @@
 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More tests => 2 * 10 + 9 + 1;
 
-use Variable::Magic qw/wizard cast dispell/;
+use Variable::Magic qw/cast dispell/;
 
-my @c = (0) x 12;
-my @x = (0) x 12;
+use lib 't/lib';
+use Variable::Magic::TestWatcher;
 
-sub check {
- is join(':', map { (defined) ? $_ : 'u' } @c[0 .. 11]),
-    join(':', map { (defined) ? $_ : 'u' } @x[0 .. 11]),
-    $_[0];
-}
-
-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] },
-                 copy  => sub { ++$c[5] },
-                 dup   => sub { ++$c[6] },
-                 local => sub { ++$c[7] },
-                 fetch => sub { ++$c[8] },
-                 store => sub { ++$c[9] },
-                 'exists' => sub { ++$c[10] },
-                 'delete' => sub { ++$c[11] };
-check('code : create wizard');
+my $wiz = init
+        [ qw/get set len clear free copy dup local fetch store exists delete/ ],
+        'code';
 
 my $x = 0;
 sub hlagh { ++$x };
 
-cast &hlagh, $wiz;
-check('code : cast');
+check { cast &hlagh, $wiz } { }, 'cast';
+is $x, 0, 'code: cast didn\'t called code';
 
-hlagh();
-check('code : call without arguments');
-is($x, 1, 'code : call without arguments succeeded');
+check { hlagh() } { }, 'call without arguments';
+is $x, 1, 'code: call without arguments succeeded';
 
-hlagh(1, 2, 3);
-check('code : call with arguments');
-is($x, 2, 'code : call with arguments succeeded');
+check { hlagh(1, 2, 3) } { }, 'call with arguments';
+is $x, 2, 'code: call with arguments succeeded';
 
-undef *hlagh;
-++$x[4];
-check('code : undef symbol table');
-is($x, 2, 'code : undef symbol table didn\'t call');
+check { undef *hlagh } { free => 1 }, 'undef symbol table entry';
+is $x, 2, 'code: undef symbol table entry didn\'t call code';
 
 my $y = 0;
-*hlagh = sub { ++$y };
+check { *hlagh = sub { ++$y } } { }, 'redefining sub';
 
-cast &hlagh, $wiz;
-check('code : re-cast');
+check { cast &hlagh, $wiz } { }, 're-cast';
+is $y, 0, 'code: re-cast didn\'t called code';
 
-my $r = \&hlagh;
-check('code : take reference');
+my ($r) = check { \&hlagh } { }, 'reference';
+is $y, 0, 'code: reference didn\'t called code';
 
-$r->();
-check('code : call reference');
-is($y, 1, 'code : call reference succeeded');
-is($x, 2, 'code : call reference didn\'t triggered the previous code');
+check { $r->() } { }, 'call reference';
+is $y, 1, 'code: call reference succeeded';
+is $x, 2, 'code: call reference didn\'t called the previous code';
 
-dispell &hlagh, $wiz;
-check('code : dispell');
+check { dispell &hlagh, $wiz } { }, 'dispell';
+is $y, 1, 'code: dispell didn\'t called code';