1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
#!perl -w
use strict;
use constant HAS_THREADS => eval{ require threads };
use Test::More;
BEGIN{
if($INC{'Devel/Cover.pm'}){
plan skip_all => '(under -d:Cover)';
}
if(HAS_THREADS){
plan tests => 17;
}
else{
plan skip_all => 'requires threads';
}
}
use threads;
use threads 'yield';
use threads::shared;
use Data::Util qw(:all);
BEGIN{
package Foo;
sub new{
bless {} => shift;
}
package Bar;
our @ISA = qw(Foo);
package Baz;
sub new{
bless [] => shift;
}
}
{
ok is_instance(Foo->new, 'Foo'), 'in the main thread';
ok is_instance(Bar->new, 'Foo');
ok !is_instance(Baz->new, 'Foo');
}
my $thr1 = async{
yield;
ok is_instance(Foo->new, 'Foo'), 'in a thread (1)';
yield;
ok is_instance(Bar->new, 'Foo');
yield;
ok !is_instance(Baz->new, 'Foo');
eval{
instance(Foo->new, 'Bar');
};
like $@, qr/Validation failed/;
return 1;
};
my $thr2 = async{
yield;
ok is_instance(Foo->new, 'Foo'), 'in a thread (2)';
yield;
ok is_instance(Bar->new, 'Foo');
yield;
ok !is_instance(Baz->new, 'Foo');
eval{
instance(Foo->new, 'Bar');
};
like $@, qr/Validation failed/;
return 1;
};
{
ok is_instance(Foo->new, 'Foo'), 'in the main thread';
ok is_instance(Bar->new, 'Foo');
ok !is_instance(Baz->new, 'Foo');
eval {
instance(Foo->new, 'Bar');
};
like $@, qr/Validation failed/;
}
ok $thr2->join(), 'join a thread (2)';
ok $thr1->join(), 'join a thread (1)';
|
