tweak RE for NaNQ? recognition
[p5sagit/p5-mst-13.2.git] / t / lib / thread.t
CommitLineData
39e571d4 1#!./perl
bf3d9ec5 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 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 16print "1..14\n";
bf3d9ec5 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 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 54sleep 6;
0f5feb8d 55print "ok 12\n";
faa19ec9 56$t->join;
8d6d311f 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