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