diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2010-06-11 07:59:48 +0100 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2010-06-11 07:59:48 +0100 |
commit | f06daabb40d6dee8a7eda2c79bd7ee3e0b6275ec (patch) | |
tree | c1347df8322db34c91f450bfe03e6651a12caeff /dist/Thread-Semaphore | |
parent | 04febe174c342d1018822ab2c67fb381bb88c55f (diff) | |
download | perl-f06daabb40d6dee8a7eda2c79bd7ee3e0b6275ec.tar.gz |
Added new files I forgot to add for the Thread-Semaphore update
Diffstat (limited to 'dist/Thread-Semaphore')
-rw-r--r-- | dist/Thread-Semaphore/t/04_nonblocking.t | 62 | ||||
-rw-r--r-- | dist/Thread-Semaphore/t/05_force.t | 59 |
2 files changed, 121 insertions, 0 deletions
diff --git a/dist/Thread-Semaphore/t/04_nonblocking.t b/dist/Thread-Semaphore/t/04_nonblocking.t new file mode 100644 index 0000000000..9c06969a41 --- /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 0000000000..c1ed70bbb9 --- /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 |