From: Vincent Pit <vince@profvince.com>
Date: Sun, 18 Jan 2009 15:44:41 +0000 (+0100)
Subject: Factor some test logic in a helper module
X-Git-Tag: v0.27~19
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=9345c3acac8d56b421b1d53b2d800294b77e9ad6;p=perl%2Fmodules%2FVariable-Magic.git

Factor some test logic in a helper module
---

diff --git a/MANIFEST b/MANIFEST
index 6be236e..0aafe9a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -38,3 +38,4 @@ t/91-pod.t
 t/92-pod-coverage.t
 t/95-portability-files.t
 t/99-kwalitee.t
+t/lib/Variable/Magic/TestWatcher.pm
diff --git a/t/lib/Variable/Magic/TestWatcher.pm b/t/lib/Variable/Magic/TestWatcher.pm
new file mode 100644
index 0000000..ef988d1
--- /dev/null
+++ b/t/lib/Variable/Magic/TestWatcher.pm
@@ -0,0 +1,61 @@
+package Variable::Magic::TestWatcher;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Carp qw/croak/;
+use Variable::Magic qw/wizard/;
+
+use base qw/Exporter/;
+
+our @EXPORT = qw/init check/;
+
+sub _types {
+ my $t = shift;
+ return { } unless defined $t;
+ return {
+  ''      => sub { +{ $t => 1 } },
+  'ARRAY' => sub { my $h = { }; ++$h->{$_} for @$t; $h },
+  'HASH'  => sub { +{ map { $_ => $t->{$_} } grep $t->{$_}, keys %$t } }
+ }->{ref $t}->();
+}
+
+our ($wiz, $prefix, %mg);
+
+sub init ($;$) {
+ croak 'can\'t initialize twice' if defined $wiz;
+ my $types = _types shift;
+ $prefix   = (defined) ? "$_: " : '' for shift;
+ %mg  = ();
+ $wiz = eval 'wizard ' . join(', ', map {
+  "$_ => sub { \$mg{$_}++;" . ($_ eq 'len' ? '$_[2]' : '0') . '}'
+ } keys %$types);
+ is        $@,   '',  $prefix . 'wizard() doesn\'t croak';
+ is_deeply \%mg, { }, $prefix . 'wizard() doesn\'t trigger magic';
+ return $wiz;
+}
+
+sub check (&;$$) {
+ my $code = shift;
+ my $exp  = _types shift;
+ my $desc = shift;
+ local %mg = ();
+ my @ret = eval { $code->() };
+ is        $@,   '',   $prefix . $desc . ' doesn\'t croak';
+ is_deeply \%mg, $exp, $prefix . $desc . ' triggers magic correctly';
+ return @ret;
+}
+
+our $mg_end;
+
+END {
+ if (defined $wiz) {
+  undef $wiz;
+  $mg_end = { } unless defined $mg_end;
+  is_deeply \%mg, $mg_end, $prefix . 'magic triggered at END time';
+ }
+}
+
+1;