7 use Variable::Magic::TestThreads;
9 use Test::More 'no_plan';
11 use Variable::Magic qw<
12 wizard cast dispell getdata
13 VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT
16 my $destroyed : shared = 0;
19 my ($dispell, $op_info) = @_;
20 my $tid = threads->tid;
29 data => sub { $_[1] + $tid },
30 get => sub { ++$c; 0 },
34 if ($op_info == VMG_OP_INFO_OBJECT) {
35 is_deeply { class => ref($op), name => $op->name },
36 { class => 'B::BINOP', name => 'sassign' },
37 "op object in thread $tid is correct";
39 is $op, 'sassign', "op name in thread $tid is correct";
44 free => sub { lock $destroyed; ++$destroyed; 0 },
48 is $@, '', "wizard in thread $tid doesn't croak";
49 isnt $wiz, undef, "wizard in thread $tid is defined";
50 is $c, 0, "wizard in thread $tid doesn't trigger magic";
57 my $res = eval { cast $a, $wiz, sub { 5 }->() };
58 is $@, '', "cast in thread $tid doesn't croak";
59 is $c, 0, "cast in thread $tid doesn't trigger magic";
66 is $@, '', "get in thread $tid doesn't croak";
67 is $b, 3, "get in thread $tid returns the right thing";
68 is $c, 1, "get in thread $tid triggers magic";
73 my $d = eval { getdata $a, $wiz };
74 is $@, '', "getdata in thread $tid doesn't croak";
75 is $d, 5 + $tid, "getdata in thread $tid returns the right thing";
76 is $c, 1, "getdata in thread $tid doesn't trigger magic";
82 is $@, '', "set in thread $tid (check opname) doesn't croak";
88 my $res = eval { dispell $a, $wiz };
89 is $@, '', "dispell in thread $tid doesn't croak";
90 is $c, 1, "dispell in thread $tid doesn't trigger magic";
97 is $@, '', "get in thread $tid after dispell doesn't croak";
98 is $b, 9, "get in thread $tid after dispell returns the right thing";
99 is $c, 1, "get in thread $tid after dispell doesn't trigger magic";
102 return; # Ugly if not here
105 for my $dispell (1, 0) {
111 my @threads = map spawn(\&try, $dispell, $_),
112 (VMG_OP_INFO_NAME) x 2, (VMG_OP_INFO_OBJECT) x 2;
113 $_->join for @threads;
117 is $destroyed, (1 - $dispell) * 4, 'destructors';