This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
8d385236cc18d6f758a1b97ee63487c519636017
[perl5.git] / t / lib / thread.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     unshift @INC, '../lib';
6     require Config; import Config;
7     if (! $Config{'usethreads'}) {
8         print "1..0\n";
9         exit 0;
10     }
11
12     # XXX known trouble with global destruction
13     $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
14 }
15 $| = 1;
16 print "1..14\n";
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
37 sub dorecurse
38 {
39  my $val = shift;
40  my $ret;
41  print $val;
42  if (@_)
43   {
44    $ret = Thread->new(\&dorecurse, @_);
45    $ret->join;
46   }
47 }
48
49 $t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
50 $t->join;
51
52 # test that sleep lets other thread run
53 $t = new Thread \&dorecurse,"ok 11\n";
54 sleep 6;
55 print "ok 12\n";
56 $t->join;
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