Commit | Line | Data |
---|---|---|
39e571d4 | 1 | #!./perl |
bf3d9ec5 | 2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require Config; import Config; | |
dfe9444c | 7 | if (! $Config{'usethreads'}) { |
bf3d9ec5 | 8 | print "1..0\n"; |
9 | exit 0; | |
10 | } | |
9c63abab | 11 | |
12 | # XXX known trouble with global destruction | |
13 | $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; | |
bf3d9ec5 | 14 | } |
15 | $| = 1; | |
8d6d311f | 16 | print "1..14\n"; |
bf3d9ec5 | 17 | use Thread; |
18 | print "ok 1\n"; | |
19 | ||
20 | sub content | |
21 | { | |
22 | print shift; | |
23 | return shift; | |
24 | } | |
25 | ||
26 | # create a thread passing args and immedaietly wait for it. | |
27 | my $t = new Thread \&content,("ok 2\n","ok 3\n"); | |
28 | print $t->join; | |
29 | ||
30 | # check that lock works ... | |
31 | {lock $foo; | |
32 | $t = new Thread sub { lock $foo; print "ok 5\n" }; | |
33 | print "ok 4\n"; | |
34 | } | |
35 | $t->join; | |
36 | ||
8d6d311f | 37 | sub dorecurse |
bf3d9ec5 | 38 | { |
bf3d9ec5 | 39 | my $val = shift; |
40 | my $ret; | |
0f5feb8d | 41 | print $val; |
bf3d9ec5 | 42 | if (@_) |
43 | { | |
8d6d311f | 44 | $ret = Thread->new(\&dorecurse, @_); |
faa19ec9 | 45 | $ret->join; |
bf3d9ec5 | 46 | } |
bf3d9ec5 | 47 | } |
48 | ||
8d6d311f | 49 | $t = new Thread \&dorecurse, map { "ok $_\n" } 6..10; |
faa19ec9 | 50 | $t->join; |
bf3d9ec5 | 51 | |
52 | # test that sleep lets other thread run | |
8d6d311f | 53 | $t = new Thread \&dorecurse,"ok 11\n"; |
61bb5906 | 54 | sleep 6; |
0f5feb8d | 55 | print "ok 12\n"; |
faa19ec9 | 56 | $t->join; |
8d6d311f | 57 | |
58 | sub islocked | |
59 | { | |
60 | use attrs 'locked'; | |
61 | my $val = shift; | |
62 | my $ret; | |
63 | print $val; | |
64 | if (@_) | |
65 | { | |
66 | $ret = Thread->new(\&islocked, shift); | |
67 | } | |
68 | $ret; | |
69 | } | |
70 | ||
71 | $t = Thread->new(\&islocked, "ok 13\n", "ok 14\n"); | |
72 | $t->join->join; | |
73 |