1package Variable::Magic::TestValue;
2
3use strict;
4use warnings;
5
6use Test::More;
7
8use Variable::Magic qw<wizard cast>;
9
10use base qw<Exporter>;
11
12our @EXPORT = qw<init_value value>;
13
14our ($exp, $prefix, $desc);
15
16sub value_cb {
17 my $data = $_[1];
18 return if $data->{guard};
19 local $data->{guard} = 1;
20 local $Test::Builder::Level = ($Test::Builder::Level || 0) + 3;
21 is_deeply $_[0], $exp, $desc;
22 ()
23}
24
25sub init_value (\[$@%&*]$;$) {
26 my $type = $_[1];
27 $prefix  = (defined) ? "$_: " : '' for $_[2];
28 my $wiz  = eval "wizard data => sub { +{ guard => 0 } }, $type => \\&value_cb";
29 is $@, '', $prefix . 'wizard() doesn\'t croak';
30 eval { &cast($_[0], $wiz, $prefix) };
31 is $@, '', $prefix . 'cast() doesn\'t croak';
32 return $wiz;
33}
34
35sub value (&$;$) {
36 my ($code, $_exp, $_desc) = @_;
37 my $want = wantarray;
38 $_desc = 'value' unless defined $desc;
39 $_desc = $prefix . $_desc;
40 my @ret;
41 {
42  local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1;
43  local $exp  = $_exp;
44  local $desc = $_desc;
45  if (defined $want and not $want) { # scalar context
46   $ret[0] = eval { $code->() };
47  } else {
48   @ret = eval { $code->() };
49  }
50  is $@, '', $desc . ' doesn\'t croak';
51 }
52 return $want ? @ret : $ret[0];
53}
54
551;
56