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
|
#
# make sure many threads all get same default paths.
#
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') {
#
# In perl-5.10.0, Perl_parser_dup() was called with a null pointer
# to indicate (presumably) that there was no parser to dup. The
# first thing it did was to check for the null then return null.
# However, Perl_parser_dup was prototyped with a nonnull attribute
# applied to both its' args, causing the null check to later be
# optimized away with -O2 on gcc-like compilers.
#
# Perl_parser_dup along with the null test and the nonnull
# attributes were introduced in perl-5.9.5.
#
# The nonnull attribute for parser arg was removed in
# perl-5.10.1-RC1.
#
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 Test::More;
use MyNote;
use Try::Tiny;
use vars qw(@OPTS);
BEGIN {
@OPTS = qw(:persist=foo);
ok 1, 'began';
}
use UUID @OPTS;
ok 1, 'loaded';
my $cnt = 0;
share($cnt);
sub t (&) {
my $t = shift;
my ($rv, $err);
$rv = try { $t->() } catch { $err = $_; undef };
return $rv, $err;
}
sub doit {
note 'in doit()';
my $c; { lock $cnt; $c = ++$cnt }
note "c: $c";
my ($rv,$er) = t{ UUID::_persist() };
is $rv, 'foo', "path seems correct $cnt";
is $er, undef, "path correct $cnt";
}
note 'spawn 1'; my $thr1 = threads->create(\&doit); $thr1->join;
note 'spawn 2'; my $thr2 = threads->create(\&doit); $thr2->join;
note 'spawn 3'; my $thr3 = threads->create(\&doit); $thr3->join;
note 'spawn 4'; my $thr4 = threads->create(\&doit);
note 'spawn 5'; my $thr5 = threads->create(\&doit);
note 'spawn 6'; my $thr6 = threads->create(\&doit);
$thr4->join;
$thr6->join;
$thr5->join;
done_testing;
|
