Commit | Line | Data |
---|---|---|
47ba8780 | 1 | |
a54396a0 AB |
2 | |
3 | # | |
4 | # The reason this does not use a Test module is that | |
5 | # they mess up test numbers between threads | |
6 | # | |
7 | # And even when that will be fixed, this is a basic | |
8 | # test and should not rely on shared variables | |
9 | # | |
10 | # | |
47ba8780 AB |
11 | ######################### |
12 | ||
a54396a0 | 13 | |
47ba8780 | 14 | use ExtUtils::testlib; |
47ba8780 | 15 | use strict; |
a54396a0 | 16 | BEGIN { print "1..12\n" }; |
47ba8780 AB |
17 | use threads; |
18 | ||
19 | ||
a54396a0 AB |
20 | |
21 | print "ok 1\n"; | |
22 | ||
47ba8780 AB |
23 | |
24 | ######################### | |
25 | ||
26 | # Insert your test code below, the Test module is use()ed here so read | |
27 | # its man page ( perldoc Test ) for help writing this test script. | |
28 | #my $bar; | |
a54396a0 AB |
29 | sub ok { |
30 | my ($id, $ok, $name) = @_; | |
31 | ||
32 | # You have to do it this way or VMS will get confused. | |
33 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; | |
34 | ||
35 | printf "# Failed test at line %d\n", (caller)[2] unless $ok; | |
36 | ||
37 | return $ok; | |
38 | } | |
39 | ||
40 | ||
47ba8780 | 41 | |
47ba8780 AB |
42 | |
43 | #test passing of simple argument | |
a54396a0 | 44 | my $thread = threads->create(sub { ok(2, 'bar' eq $_[0]),"" },"bar"); |
47ba8780 | 45 | $thread->join(); |
a54396a0 | 46 | |
47ba8780 AB |
47 | |
48 | #test passing of complex argument | |
49 | ||
a54396a0 | 50 | $thread = threads->create(sub { ok(3, 'bar' eq $_[0]->[0]->{foo})},[{foo => 'bar'}]); |
47ba8780 AB |
51 | |
52 | $thread->join(); | |
a54396a0 | 53 | |
47ba8780 AB |
54 | |
55 | #test execuion of normal sub | |
a54396a0 | 56 | sub bar { ok(4,shift() == 1,"") } |
47ba8780 | 57 | threads->create(\&bar,1)->join(); |
a54396a0 | 58 | |
47ba8780 AB |
59 | |
60 | #check Config | |
a54396a0 | 61 | ok(5, 1 == $Config::threads,""); |
47ba8780 AB |
62 | |
63 | #test trying to detach thread | |
64 | ||
a54396a0 | 65 | my $thread1 = threads->create(sub {ok(6,1,"")}); |
47ba8780 AB |
66 | |
67 | $thread1->detach(); | |
47ba8780 | 68 | sleep 1; |
a54396a0 | 69 | ok(7,1,""); |
47ba8780 AB |
70 | #create nested threads |
71 | unless($^O eq 'MSWin32') { | |
72 | my $thread3 = threads->create(sub { threads->create(sub {})})->join(); | |
47ba8780 | 73 | } |
a54396a0 | 74 | |
47ba8780 AB |
75 | |
76 | my @threads; | |
77 | my $i; | |
78 | unless($^O eq 'MSWin32') { | |
79 | for(1..25) { | |
80 | push @threads, threads->create(sub { for(1..100000) { my $i } threads->create(sub { sleep 2})->join() }); | |
81 | } | |
82 | foreach my $thread (@threads) { | |
83 | $thread->join(); | |
84 | } | |
85 | } | |
a54396a0 | 86 | ok(8,1,""); |
47ba8780 AB |
87 | threads->create(sub { |
88 | my $self = threads->self(); | |
a54396a0 | 89 | ok(9,$self->tid() == 57,""); |
47ba8780 | 90 | })->join(); |
47ba8780 AB |
91 | threads->create(sub { |
92 | my $self = threads->self(); | |
a54396a0 | 93 | ok(10,$self->tid() == 58,""); |
47ba8780 | 94 | })->join(); |
47ba8780 AB |
95 | |
96 | #check support for threads->self() in main thread | |
a54396a0 AB |
97 | ok(11, 0 == threads->self->tid(),""); |
98 | ok(12, 0 == threads->tid(),"Check so that tid for threads work for current tid"); | |
47ba8780 AB |
99 | |
100 | ||
101 | ||
102 | ||
103 | ||
104 | ||
105 | ||
106 | ||
107 | ||
108 |