Commit | Line | Data |
39e571d4 |
1 | #!./perl |
bf3d9ec5 |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
93430cb4 |
5 | unshift @INC, '../lib'; |
bf3d9ec5 |
6 | require Config; import Config; |
dfe9444c |
7 | if (! $Config{'usethreads'}) { |
45c0de28 |
8 | print "1..0 # Skip: this perl is not threaded\n"; |
bf3d9ec5 |
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; |
13e08037 |
16 | print "1..18\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. |
c4e7bd8d |
27 | my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000); |
bf3d9ec5 |
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 | |
13e08037 |
74 | { |
75 | package Loch::Ness; |
76 | sub new { bless [], shift } |
77 | sub monster { |
78 | use attrs qw(locked method); |
79 | my($s, $m) = @_; |
80 | print "ok $m\n"; |
81 | } |
82 | sub gollum { &monster } |
83 | } |
84 | Loch::Ness->monster(15); |
85 | Loch::Ness->new->monster(16); |
86 | Loch::Ness->gollum(17); |
87 | Loch::Ness->new->gollum(18); |