From: Chris 'BinGOs' Williams Date: Fri, 11 Jun 2010 06:59:48 +0000 (+0100) Subject: Added new files I forgot to add for the Thread-Semaphore update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f06daabb40d6dee8a7eda2c79bd7ee3e0b6275ec;p=p5sagit%2Fp5-mst-13.2.git Added new files I forgot to add for the Thread-Semaphore update --- diff --git a/dist/Thread-Semaphore/t/04_nonblocking.t b/dist/Thread-Semaphore/t/04_nonblocking.t new file mode 100644 index 0000000..9c06969 --- /dev/null +++ b/dist/Thread-Semaphore/t/04_nonblocking.t @@ -0,0 +1,62 @@ +use strict; +use warnings; + +BEGIN { + use Config; + if (! $Config{'useithreads'}) { + print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); + exit(0); + } +} + +use threads; +use threads::shared; +use Thread::Semaphore; + +if ($] == 5.008) { + require 't/test.pl'; # Test::More work-alike for Perl 5.8.0 +} else { + require Test::More; +} +Test::More->import(); +plan('tests' => 13); + +### Basic usage with multiple threads ### + +my $sm = Thread::Semaphore->new(0); +my $st = Thread::Semaphore->new(0); +ok($sm, 'New Semaphore'); +ok($st, 'New Semaphore'); + +my $token :shared = 0; + +threads->create(sub { + ok(! $st->down_nb(), 'Semaphore unavailable to thread'); + $sm->up(); + + $st->down(2); + ok(! $st->down_nb(5), 'Semaphore unavailable to thread'); + ok($st->down_nb(2), 'Thread 1 got semaphore'); + ok(! $st->down_nb(2), 'Semaphore unavailable to thread'); + ok($st->down_nb(1), 'Thread 1 got semaphore'); + ok(! $st->down_nb(), 'Semaphore unavailable to thread'); + is($token++, 1, 'Thread done'); + $sm->up(); +})->detach(); + +$sm->down(1); +is($token++, 0, 'Main has semaphore'); +$st->up(); + +ok(! $sm->down_nb(), 'Semaphore unavailable to main'); +$st->up(4); + +$sm->down(); +is($token++, 2, 'Main got semaphore'); + +ok(1, 'Main done'); +threads::yield(); + +exit(0); + +# EOF diff --git a/dist/Thread-Semaphore/t/05_force.t b/dist/Thread-Semaphore/t/05_force.t new file mode 100644 index 0000000..c1ed70b --- /dev/null +++ b/dist/Thread-Semaphore/t/05_force.t @@ -0,0 +1,59 @@ +use strict; +use warnings; + +BEGIN { + use Config; + if (! $Config{'useithreads'}) { + print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); + exit(0); + } +} + +use threads; +use threads::shared; +use Thread::Semaphore; + +if ($] == 5.008) { + require 't/test.pl'; # Test::More work-alike for Perl 5.8.0 +} else { + require Test::More; +} +Test::More->import(); +plan('tests' => 8); + +### Basic usage with multiple threads ### + +my $sm = Thread::Semaphore->new(0); +my $st = Thread::Semaphore->new(0); +ok($sm, 'New Semaphore'); +ok($st, 'New Semaphore'); + +my $token :shared = 0; + +threads->create(sub { + $st->down_force(2); + is($token++, 0, 'Thread got semaphore'); + $sm->up(); + + $st->down(); + is($token++, 3, 'Thread done'); + $sm->up(); +})->detach(); + +$sm->down(); +is($token++, 1, 'Main has semaphore'); +$st->up(2); +threads::yield(); + +is($token++, 2, 'Main still has semaphore'); +$st->up(); + +$sm->down(); +is($token, 4, 'Main re-got semaphore'); + +ok(1, 'Main done'); +threads::yield(); + +exit(0); + +# EOF