X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F14-callbacks.t;h=eb72559acbf75e4afe8e9688b01aa1662a2c7d00;hb=eca9d54dfe50df3daace0c4aa552289258cf6c68;hp=cc4eb4c588acafe817cdc9d71a1bd2af53475975;hpb=0842790276f868200cec87bdcf6fdbbd8b23dc5e;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/14-callbacks.t b/t/14-callbacks.t index cc4eb4c..eb72559 100644 --- a/t/14-callbacks.t +++ b/t/14-callbacks.t @@ -3,9 +3,9 @@ use strict; use warnings; -use Test::More tests => 12 + 9 * (5 + 6 + 5); +use Test::More tests => 12; -use Variable::Magic qw/wizard cast dispell VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/; +use Variable::Magic qw/wizard cast/; my $wiz = eval { wizard get => sub { undef } }; is($@, '', 'wizard creation doesn\'t croak'); @@ -65,60 +65,3 @@ is_deeply(\@callers, [ ([ 'main', $0, __LINE__-3 ]) x 2, ], 'caller into callback into eval returns the right thing'); -sub Variable::Magic::TestPkg::foo { } - -my @tests = ( - [ 'len', '@c', undef, 'my $x = @c', [ 'padav', 'B::OP' ] ], - [ 'get', '$c', undef, '++$c', [ 'preinc', 'B::UNOP' ] ], - [ 'get', '$c', '$c = 1', '$c ** 2', [ 'pow', 'B::BINOP' ] ], - [ 'get', '$c', undef, 'my $x = $c', [ 'sassign', 'B::BINOP' ] ], - [ 'get', '$c', undef, '1 if $c', [ 'and', 'B::LOGOP' ] ], - [ 'set', '$c', undef, 'bless \$c, "main"', [ 'bless', 'B::LISTOP' ] ], - [ 'get', '$c', '$c = ""', '$c =~ /x/', [ 'match', 'B::PMOP' ] ], - [ 'get', '$c', '$c = "Variable::Magic::TestPkg"', - '$c->foo()', [ 'method_named', 'B::SVOP' ] ], - [ 'get', '$c', '$c = ""', '$c =~ y/x/y/', [ 'trans', 'B::PVOP' ] ], -); - -for (@tests) { - my ($key, $var, $init, $test, $exp) = @$_; - - for my $op_info (VMG_OP_INFO_NAME, VMG_OP_INFO_OBJECT, 3) { - our $done; - 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 { - return if $done; - my $op = $_[-1]; - my $desc = "$key magic with op_info == $op_info"; - if ($op_info == 1) { - is $op, $exp->[0], "$desc gets the right op info"; - } elsif ($op_info == 2) { - isa_ok $op, $exp->[1], $desc; - is $op->name, $exp->[0], "$desc gets the right op info"; - } else { - is $op, undef, "$desc gets the right op info"; - } - $done = 1; - () - }, op_info => $op_info - }; - is $@, '', "$key wizard with op_info == $op_info doesn't croak"; - - eval $init if defined $init; - - eval "cast $var, \$wiz"; - is $@, '', "$key cast with op_info == $op_info doesn't croak"; - - local $done = 0; - eval $test; - 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"; - } -}