]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/40-threads.t
Update VPIT::TestHelpers to 6d578776
[perl/modules/Variable-Magic.git] / t / 40-threads.t
1 #!perl
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use VPIT::TestHelpers (
8  threads => [ 'Variable::Magic' => 'Variable::Magic::VMG_THREADSAFE()' ],
9 );
10
11 use Test::Leaner 'no_plan';
12
13 my $destroyed : shared = 0;
14
15 sub try {
16  my ($dispell, $op_info) = @_;
17  my $tid = threads->tid;
18
19  my $c = 0;
20  my $wiz;
21
22  {
23   local $@;
24   eval { require Variable::Magic; 1 } or return;
25  }
26
27  {
28   local $@;
29   $wiz = eval {
30    Variable::Magic::wizard(
31     data    => sub { $_[1] + $tid },
32     get     => sub { ++$c; 0 },
33     set     => sub {
34      my $op = $_[-1];
35
36      if ($op_info eq 'object') {
37       is_deeply { class => ref($op),   name => $op->name },
38                 { class => 'B::BINOP', name => 'sassign' },
39                 "op object in thread $tid is correct";
40      } else {
41       is $op, 'sassign', "op name in thread $tid is correct";
42      }
43
44      return 0;
45     },
46     free    => sub { lock $destroyed; ++$destroyed; 0 },
47     op_info => $op_info eq 'object' ? Variable::Magic::VMG_OP_INFO_OBJECT()
48                                     : Variable::Magic::VMG_OP_INFO_NAME()
49    );
50   };
51   is $@,     '',    "wizard in thread $tid doesn't croak";
52   isnt $wiz, undef, "wizard in thread $tid is defined";
53   is $c,     0,     "wizard in thread $tid doesn't trigger magic";
54  }
55
56  my $a = 3;
57
58  {
59   local $@;
60   my $res = eval { &Variable::Magic::cast(\$a, $wiz, sub { 5 }->()) };
61   is $@, '', "cast in thread $tid doesn't croak";
62   is $c, 0,  "cast in thread $tid doesn't trigger magic";
63  }
64
65  {
66   local $@;
67   my $b;
68   eval { $b = $a };
69   is $@, '', "get in thread $tid doesn't croak";
70   is $b, 3,  "get in thread $tid returns the right thing";
71   is $c, 1,  "get in thread $tid triggers magic";
72  }
73
74  {
75   local $@;
76   my $d = eval { &Variable::Magic::getdata(\$a, $wiz) };
77   is $@, '',       "getdata in thread $tid doesn't croak";
78   is $d, 5 + $tid, "getdata in thread $tid returns the right thing";
79   is $c, 1,        "getdata in thread $tid doesn't trigger magic";
80  }
81
82  {
83   local $@;
84   eval { $a = 9 };
85   is $@, '', "set in thread $tid (check opname) doesn't croak";
86  }
87
88  if ($dispell) {
89   {
90    local $@;
91    my $res = eval { &Variable::Magic::dispell(\$a, $wiz) };
92    is $@, '', "dispell in thread $tid doesn't croak";
93    is $c, 1,  "dispell in thread $tid doesn't trigger magic";
94   }
95
96   {
97    local $@;
98    my $b;
99    eval { $b = $a };
100    is $@, '', "get in thread $tid after dispell doesn't croak";
101    is $b, 9,  "get in thread $tid after dispell returns the right thing";
102    is $c, 1,  "get in thread $tid after dispell doesn't trigger magic";
103   }
104  }
105  return; # Ugly if not here
106 }
107
108 for my $dispell (1, 0) {
109  {
110   lock $destroyed;
111   $destroyed = 0;
112  }
113
114  my @threads = map spawn(\&try, $dispell, $_), ('name') x 2, ('object') x 2;
115  $_->join for @threads;
116
117  {
118   lock $destroyed;
119   is $destroyed, (1 - $dispell) * 4, 'destructors';
120  }
121 }