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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
#
# make sure v1 works in threads.
#
use strict;
use warnings;
use version 0.77;
use Config;
BEGIN {
unless ($Config{useithreads}) {
print "1..0 # SKIP no ithreads\n";
exit 0;
}
my $v = version->parse($Config{version});
if ($v >= '5.9.5' and $v < '5.10.1') {
# See note in t/5persist/threads.t.
print "1..0 # SKIP threads broken in Perl_parser_dup\n";
exit 0;
}
if ($Config{osname} eq 'openbsd' and $Config{osvers} eq '7.0') {
print "1..0 # SKIP OpenBSD 7.0 threads broken?\n";
exit 0;
}
}
use threads;
use threads::shared;
use Thread::Semaphore;
use Test::More;
use MyNote;
use vars qw(@OPTS);
BEGIN {
@OPTS = qw(uuid5);
ok 1, 'began';
}
use UUID @OPTS;
ok 1, 'loaded';
my $sync = 0;
my $seen = {};
my $mutex = Thread::Semaphore->new(0); # locked
note 'mutex init';
share($sync);
note 'shared sync';
share($seen);
note 'shared seen';
share($mutex);
note 'shared mutex';
my ($t10, $t11, $t12, $t13, $t14, $t15, $t16, $t17, $t18, $t19);
my $cnt = 0;
$t10 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t11 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t12 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t13 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t14 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t15 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t16 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t17 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t18 = threads->create(\&doit, ++$cnt);
note 'threads created';
$t19 = threads->create(\&doit, ++$cnt);
note 'threads created';
note 'waiting';
my $timeout = 20; # 5 secs
while (1) {
my $s;
{ lock($sync); $s = $sync }
note "so far: $s";
last if $s >= 10;
select undef, undef, undef, 0.25;
next if --$timeout > 0;
fail 'Waiting too long';
plan skip_all => 'HUNG';
}
note 'do it';
$mutex->up(10); # thundering herd!
$t10->join; $t11->join; $t12->join; $t13->join; $t14->join;
$t15->join; $t16->join; $t17->join; $t18->join; $t19->join;
sub doit {
note 'in doit()';
my $i = shift;
note "reporting $i";
{ lock $sync; ++$sync }
note "requesting $i";
$mutex->down;
note "generating $i";
my $uu = uuid5(dns => 'www.example.com');
note "releasing $i";
$mutex->up;
note $uu;
lock $seen;
note "recording $i";
++$seen->{$uu};
}
is scalar(keys %$seen), 1, 'all dupes';
if ((scalar keys %$seen) != 0) {
note "$_ $seen->{$_}"
for sort keys %$seen;
}
done_testing;
|
