]> git.vpit.fr Git - perl/modules/Variable-Magic.git/commitdiff
Factor some test logic in a helper module
authorVincent Pit <vince@profvince.com>
Sun, 18 Jan 2009 15:44:41 +0000 (16:44 +0100)
committerVincent Pit <vince@profvince.com>
Sun, 18 Jan 2009 15:44:41 +0000 (16:44 +0100)
MANIFEST
t/lib/Variable/Magic/TestWatcher.pm [new file with mode: 0644]

index 6be236ec30931217e1cea77299da7154844e41cf..0aafe9a00cc4ce7f2758ef346149ff641cbab3fd 100644 (file)
--- 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 (file)
index 0000000..ef988d1
--- /dev/null
@@ -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;