package Variable::Magic::TestValue; use strict; use warnings; use Test::More; use Variable::Magic qw/wizard cast/; use base qw/Exporter/; our @EXPORT = qw/init_value value/; our ($exp, $prefix, $desc); sub value_cb { my $data = $_[1]; return if $data->{guard}; local $data->{guard} = 1; local $Test::Builder::Level = ($Test::Builder::Level || 0) + 3; is_deeply $_[0], $exp, $desc; () } sub init_value (\[$@%&*]$;$) { my $type = $_[1]; $prefix = (defined) ? "$_: " : '' for $_[2]; my $wiz = eval "wizard data => sub { +{ guard => 0 } }, $type => \\&value_cb"; is $@, '', $prefix . 'wizard() doesn\'t croak'; eval { &cast($_[0], $wiz, $prefix) }; is $@, '', $prefix . 'cast() doesn\'t croak'; return $wiz; } sub value (&$;$) { my ($code, $_exp, $_desc) = @_; my $want = wantarray; $_desc = 'value' unless defined $desc; $_desc = $prefix . $_desc; my @ret; { local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1; local $exp = $_exp; local $desc = $_desc; if (defined $want and not $want) { # scalar context $ret[0] = eval { $code->() }; } else { @ret = eval { $code->() }; } is $@, '', $desc . ' doesn\'t croak'; } return $want ? @ret : $ret[0]; } 1;