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