6 use Test::More tests => 12 * (5 + 6) + 4 + 5;
8 use Config qw/%Config/;
10 use Variable::Magic qw/wizard cast dispell VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/;
12 sub Variable::Magic::TestPkg::foo { }
14 my $aelem = $] <= 5.008003 ? 'aelem' : 'aelemfast';
15 my $aelem_op = $Config{useithreads} ? 'B::PADOP' : 'B::SVOP';
20 [ 'len', '@c', undef, 'my $x = @c', [ 'padav', 'B::OP' ] ],
21 [ 'get', '$c[0]', undef, 'my $x = $c[0]', [ $aelem, 'B::OP' ] ],
22 [ 'get', '$o[0]', undef, 'my $x = $o[0]', [ 'aelemfast', $aelem_op ] ],
23 [ 'get', '$c', undef, '++$c', [ 'preinc', 'B::UNOP' ] ],
24 [ 'get', '$c', '$c = 1', '$c ** 2', [ 'pow', 'B::BINOP' ] ],
25 [ 'get', '$c', undef, 'my $x = $c', [ 'sassign', 'B::BINOP' ] ],
26 [ 'get', '$c', undef, '1 if $c', [ 'and', 'B::LOGOP' ] ],
27 [ 'set', '$c', undef, 'bless \$c, "main"', [ 'bless', 'B::LISTOP' ] ],
28 [ 'get', '$c', '$c = ""', '$c =~ /x/', [ 'match', 'B::PMOP' ] ],
29 [ 'get', '$c', '$c = "Variable::Magic::TestPkg"',
30 '$c->foo()', [ 'method_named', 'B::SVOP' ] ],
31 [ 'get', '$c', '$c = ""', '$c =~ y/x/y/', [ 'trans', 'B::PVOP' ] ],
32 [ 'get', '$c', '$c = 1', '1 for 1 .. $c', [ 'enteriter', 'B::LOOP' ] ],
36 my ($key, $var, $init, $test, $exp) = @$_;
38 for my $op_info (VMG_OP_INFO_NAME, VMG_OP_INFO_OBJECT) {
43 # We must test for the $op correctness inside the callback because, if we
44 # bring it out, it will go outside of the eval STRING scope, and what it
45 # points to will no longer exist.
47 $wiz = wizard $key => sub {
50 my $desc = "$key magic with op_info == $op_info";
51 if ($op_info == VMG_OP_INFO_NAME) {
52 is $op, $exp->[0], "$desc gets the right op info";
53 } elsif ($op_info == VMG_OP_INFO_OBJECT) {
54 isa_ok $op, $exp->[1], $desc;
55 is $op->name, $exp->[0], "$desc gets the right op info";
57 is $op, undef, "$desc gets the right op info";
61 }, op_info => $op_info
63 is $@, '', "$key wizard with op_info == $op_info doesn't croak";
67 eval $init if defined $init;
69 eval "cast $var, \$wiz";
70 is $@, '', "$key cast with op_info == $op_info doesn't croak";
73 is $@, '', "$key magic with op_info == $op_info doesn't croak";
75 eval "dispell $var, \$wiz";
76 is $@, '', "$key dispell with op_info == $op_info doesn't croak";
83 my $op_info = VMG_OP_INFO_OBJECT;
87 my $desc = "free magic with op_info == $op_info";
88 isa_ok $op, 'B::OP', $desc;
89 is $op->name, 'leaveloop', "$desc gets the right op info";
91 }, op_info => $op_info;
93 is $@, '', "get wizard with out of bounds op_info doesn't croak";
95 eval { cast $c, $wiz };
96 is $@, '', "get cast with out of bounds op_info doesn't croak";
104 is $_[-1], undef, 'get magic with out of bounds op_info';
108 is $@, '', "get wizard with out of bounds op_info doesn't croak";
110 eval { cast $c, $wiz };
111 is $@, '', "get cast with out of bounds op_info doesn't croak";
114 is $@, '', "get magic with out of bounds op_info doesn't croak";
116 eval { dispell $c, $wiz };
117 is $@, '', "get dispell with out of bounds op_info doesn't croak";