This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix failure of C<&locked_sub;> under -Dusethreads
[perl5.git] / t / lib / thread.t
CommitLineData
39e571d4 1#!./perl
bf3d9ec5
NIS
2
3BEGIN {
4 chdir 't' if -d 't';
93430cb4 5 unshift @INC, '../lib';
bf3d9ec5 6 require Config; import Config;
dfe9444c 7 if (! $Config{'usethreads'}) {
bf3d9ec5
NIS
8 print "1..0\n";
9 exit 0;
10 }
9c63abab
GS
11
12 # XXX known trouble with global destruction
13 $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
bf3d9ec5
NIS
14}
15$| = 1;
13e08037 16print "1..18\n";
bf3d9ec5
NIS
17use Thread;
18print "ok 1\n";
19
20sub content
21{
22 print shift;
23 return shift;
24}
25
26# create a thread passing args and immedaietly wait for it.
27my $t = new Thread \&content,("ok 2\n","ok 3\n");
28print $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 37sub dorecurse
bf3d9ec5 38{
bf3d9ec5
NIS
39 my $val = shift;
40 my $ret;
0f5feb8d 41 print $val;
bf3d9ec5
NIS
42 if (@_)
43 {
8d6d311f 44 $ret = Thread->new(\&dorecurse, @_);
faa19ec9 45 $ret->join;
bf3d9ec5 46 }
bf3d9ec5
NIS
47}
48
8d6d311f 49$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
faa19ec9 50$t->join;
bf3d9ec5
NIS
51
52# test that sleep lets other thread run
8d6d311f 53$t = new Thread \&dorecurse,"ok 11\n";
61bb5906 54sleep 6;
0f5feb8d 55print "ok 12\n";
faa19ec9 56$t->join;
8d6d311f
GS
57
58sub 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
GS
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}
84Loch::Ness->monster(15);
85Loch::Ness->new->monster(16);
86Loch::Ness->gollum(17);
87Loch::Ness->new->gollum(18);