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' => 12); 23 24### Basic usage with multiple threads ### 25 26my $sm = Thread::Semaphore->new(0); 27my $st = Thread::Semaphore->new(0); 28ok($sm, 'New Semaphore'); 29ok($st, 'New Semaphore'); 30 31my $token :shared = 0; 32 33my $thread = threads->create(sub { 34 ok(! $st->down_nb(), 'Semaphore unavailable to thread'); 35 $sm->up(); 36 37 $st->down(2); 38 ok(! $st->down_nb(5), 'Semaphore unavailable to thread'); 39 ok($st->down_nb(2), 'Thread 1 got semaphore'); 40 ok(! $st->down_nb(2), 'Semaphore unavailable to thread'); 41 ok($st->down_nb(1), 'Thread 1 got semaphore'); 42 ok(! $st->down_nb(), 'Semaphore unavailable to thread'); 43 is($token++, 1, 'Thread done'); 44 $sm->up(); 45}); 46 47$sm->down(1); 48is($token++, 0, 'Main has semaphore'); 49$st->up(); 50 51ok(! $sm->down_nb(), 'Semaphore unavailable to main'); 52$st->up(4); 53 54$sm->down(); 55is($token++, 2, 'Main got semaphore'); 56 57$thread->join; 58exit(0); 59 60# EOF 61