X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F14-callbacks.t;h=eae92fd0ac60c4d27bb899d18242ae56a7d17ca2;hb=refs%2Ftags%2Fv0.30;hp=3cc6d934db007be28ea6127022e95d73ae9efab9;hpb=b1c000770cd87f795f7d0873d82ea72d3d1601bd;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/14-callbacks.t b/t/14-callbacks.t index 3cc6d93..eae92fd 100644 --- a/t/14-callbacks.t +++ b/t/14-callbacks.t @@ -3,9 +3,9 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 12 + (2 * 5 + 2 * 6 + 2 * 5); -use Variable::Magic qw/wizard cast/; +use Variable::Magic qw/wizard cast dispell VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/; my $wiz = eval { wizard get => sub { undef } }; is($@, '', 'wizard creation doesn\'t croak'); @@ -54,7 +54,7 @@ is_deeply(\@callers, [ @callers = (); my $u = $b; is_deeply(\@callers, [ - [ 'main', $0, __LINE__-2 ] + [ 'main', $0, __LINE__-2 ], ], 'caller into callback into block returns the right thing'); } @@ -62,6 +62,42 @@ is_deeply(\@callers, [ eval { my $u = $b }; is($@, '', 'caller into callback doesn\'t croak'); is_deeply(\@callers, [ - [ 'main', $0, __LINE__-3 ], - [ 'main', $0, __LINE__-4 ], + ([ 'main', $0, __LINE__-3 ]) x 2, ], 'caller into callback into eval returns the right thing'); + +for ([ 'get', '$c', 'sassign' ], [ 'len', '@c', 'padav' ]) { + my ($key, $var, $exp) = @$_; + + for my $op_info (VMG_OP_INFO_NAME, VMG_OP_INFO_OBJECT, 3) { + my ($c, @c); + + # We must test for the $op correctness inside the callback because, if we + # bring it out, it will go outside of the eval STRING scope, and what it + # points to will no longer exist. + eval { + $wiz = wizard $key => sub { + my $op = $_[-1]; + my $desc = "$key magic with op_info == $op_info"; + if ($op_info == 1) { + is $op, $exp, "$desc gets the right op info"; + } elsif ($op_info == 2) { + isa_ok $op, 'B::OP', $desc; + is $op->name, $exp, "$desc gets the right op info"; + } else { + is $op, undef, "$desc gets the right op info"; + } + () + }, op_info => $op_info + }; + is $@, '', "$key wizard with op_info == $op_info doesn't croak"; + + eval "cast $var, \$wiz"; + is $@, '', "$key cast with op_info == $op_info doesn't croak"; + + eval "my \$x = $var"; + is $@, '', "$key magic with op_info == $op_info doesn't croak"; + + eval "dispell $var, \$wiz"; + is $@, '', "$key dispell with op_info == $op_info doesn't croak"; + } +}