Commit | Line | Data |
89847188 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir('t'); |
7 | unshift(@INC, '../lib'); |
8 | } |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
1090e072 |
11 | print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); |
89847188 |
12 | exit(0); |
13 | } |
14 | } |
15 | |
16 | use threads; |
17 | use threads::shared; |
18 | use Thread::Semaphore; |
19 | |
20 | if ($] == 5.008) { |
21 | require 't/test.pl'; # Test::More work-alike for Perl 5.8.0 |
22 | } else { |
23 | require Test::More; |
24 | } |
25 | Test::More->import(); |
26 | plan('tests' => 10); |
27 | |
28 | ### Basic usage with multiple threads ### |
29 | |
30 | my $sm = Thread::Semaphore->new(); |
31 | my $st = Thread::Semaphore->new(0); |
32 | ok($sm, 'New Semaphore'); |
33 | ok($st, 'New Semaphore'); |
34 | |
35 | my $token :shared = 0; |
36 | |
37 | threads->create(sub { |
38 | $st->down(); |
39 | is($token++, 1, 'Thread 1 got semaphore'); |
40 | $st->up(); |
41 | $sm->up(); |
42 | |
43 | $st->down(4); |
44 | is($token, 5, 'Thread 1 done'); |
45 | $sm->up(); |
46 | })->detach(); |
47 | |
48 | threads->create(sub { |
49 | $st->down(2); |
50 | is($token++, 3, 'Thread 2 got semaphore'); |
51 | $st->up(); |
52 | $sm->up(); |
53 | |
54 | $st->down(4); |
55 | is($token, 5, 'Thread 2 done'); |
56 | $sm->up(); |
57 | })->detach(); |
58 | |
59 | $sm->down(); |
60 | is($token++, 0, 'Main has semaphore'); |
61 | $st->up(); |
62 | |
63 | $sm->down(); |
64 | is($token++, 2, 'Main got semaphore'); |
65 | $st->up(2); |
66 | |
67 | $sm->down(); |
68 | is($token++, 4, 'Main re-got semaphore'); |
69 | $st->up(9); |
70 | |
71 | $sm->down(2); |
72 | $st->down(); |
73 | ok(1, 'Main done'); |
74 | threads::yield(); |
75 | |
1090e072 |
76 | exit(0); |
77 | |
89847188 |
78 | # EOF |