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 33threads->create(sub { 34 $st->down(); 35 is($token++, 1, 'Thread 1 got semaphore'); 36 $st->up(); 37 $sm->up(); 38 39 $st->down(4); 40 is($token, 5, 'Thread 1 done'); 41 $sm->up(); 42})->detach(); 43 44threads->create(sub { 45 $st->down(2); 46 is($token++, 3, 'Thread 2 got semaphore'); 47 $st->up(); 48 $sm->up(); 49 50 $st->down(4); 51 is($token, 5, 'Thread 2 done'); 52 $sm->up(); 53})->detach(); 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(9); 66 67$sm->down(2); 68$st->down(); 69ok(1, 'Main done'); 70threads::yield(); 71 72exit(0); 73 74# EOF 75