1 package Variable::Magic::TestWatcher;
9 use Variable::Magic qw<wizard>;
11 use base qw<Exporter>;
13 our @EXPORT = qw<init_watcher watch>;
17 return { } unless defined $t;
19 '' => sub { +{ $t => 1 } },
20 'ARRAY' => sub { my $h = { }; ++$h->{$_} for @$t; $h },
21 'HASH' => sub { +{ map { $_ => $t->{$_} } grep $t->{$_}, keys %$t } }
25 our ($wiz, $prefix, %mg);
27 sub init_watcher ($;$) {
28 croak 'can\'t initialize twice' if defined $wiz;
29 my $types = _types shift;
30 $prefix = (defined) ? "$_: " : '' for shift;
33 $wiz = eval 'wizard ' . join(', ', map {
34 "$_ => sub { \$mg{$_}++;" . ($_ eq 'len' ? '$_[2]' : '0') . '}'
36 is $@, '', $prefix . 'wizard() doesn\'t croak';
37 is_deeply \%mg, { }, $prefix . 'wizard() doesn\'t trigger magic';
43 my $exp = _types shift;
48 local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1;
50 if (not defined $want) { # void context
52 } elsif (not $want) { # scalar context
53 $ret[0] = eval { $code->() };
55 @ret = eval { $code->() };
57 is $@, '', $prefix . $desc . ' doesn\'t croak';
58 is_deeply \%mg, $exp, $prefix . $desc . ' triggers magic correctly';
59 return $want ? @ret : $ret[0];
67 $mg_end = { } unless defined $mg_end;
68 is_deeply \%mg, $mg_end, $prefix . 'magic triggered at END time';