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' => 8); 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 $st->down_force(2); 35 is($token++, 0, 'Thread got semaphore'); 36 $sm->up(); 37 38 $st->down(); 39 is($token++, 3, 'Thread done'); 40 $sm->up(); 41}); 42 43$sm->down(); 44is($token++, 1, 'Main has semaphore'); 45$st->up(2); 46threads::yield(); 47 48is($token++, 2, 'Main still has semaphore'); 49$st->up(); 50 51$sm->down(); 52is($token, 4, 'Main re-got semaphore'); 53 54$thread->join; 55 56ok(1, 'Main done'); 57 58exit(0); 59 60# EOF 61