From: Jerry D. Hedden Date: Fri, 11 Jun 2010 06:57:34 +0000 (+0100) Subject: [PATCH-revised] Upgrade to Thread-Semaphore 2.11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=04febe174c342d1018822ab2c67fb381bb88c55f;p=p5sagit%2Fp5-mst-13.2.git [PATCH-revised] Upgrade to Thread-Semaphore 2.11 Added new methods ->down_nb() and ->down_force() at the suggestion of Rick Garlick. Refactored methods to skip argument validation when no argument is supplied. Signed-off-by: Chris 'BinGOs' Williams --- diff --git a/MANIFEST b/MANIFEST index 197d359..a5ab58d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2831,6 +2831,8 @@ dist/Thread-Semaphore/lib/Thread/Semaphore.pm Thread-safe semaphores dist/Thread-Semaphore/t/01_basic.t Thread::Semaphore tests dist/Thread-Semaphore/t/02_errs.t Thread::Semaphore tests dist/Thread-Semaphore/t/03_nothreads.t Thread::Semaphore tests +dist/Thread-Semaphore/t/04_nonblocking.t Thread::Semaphore tests +dist/Thread-Semaphore/t/05_force.t Thread::Semaphore tests dist/threads/hints/hpux.pl Hint file for HPUX dist/threads/hints/linux.pl Hint file for Linux dist/threads/Makefile.PL ithreads diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 49e6525..2c39cf6 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1406,7 +1406,7 @@ use File::Glob qw(:case); 'Thread::Semaphore' => { 'MAINTAINER' => 'jdhedden', - 'DISTRIBUTION' => 'JDHEDDEN/Thread-Semaphore-2.09.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/Thread-Semaphore-2.11.tar.gz', 'FILES' => q[dist/Thread-Semaphore], 'EXCLUDED' => [ qw(examples/semaphore.pl t/00_load.t diff --git a/dist/Thread-Semaphore/lib/Thread/Semaphore.pm b/dist/Thread-Semaphore/lib/Thread/Semaphore.pm index 67cb30e..8ce2429 100644 --- a/dist/Thread-Semaphore/lib/Thread/Semaphore.pm +++ b/dist/Thread-Semaphore/lib/Thread/Semaphore.pm @@ -3,60 +3,96 @@ package Thread::Semaphore; use strict; use warnings; -our $VERSION = '2.09'; +our $VERSION = '2.11'; +$VERSION = eval $VERSION; use threads::shared; use Scalar::Util 1.10 qw(looks_like_number); +# Predeclarations for internal functions +my ($validate_arg); + # Create a new semaphore optionally with specified count (count defaults to 1) sub new { my $class = shift; - my $val :shared = @_ ? shift : 1; - if (!defined($val) || - ! looks_like_number($val) || - (int($val) != $val)) - { - require Carp; - $val = 'undef' if (! defined($val)); - Carp::croak("Semaphore initializer is not an integer: $val"); + + my $val :shared = 1; + if (@_) { + $val = shift; + if (! defined($val) || + ! looks_like_number($val) || + (int($val) != $val)) + { + require Carp; + $val = 'undef' if (! defined($val)); + Carp::croak("Semaphore initializer is not an integer: $val"); + } } + return bless(\$val, $class); } # Decrement a semaphore's count (decrement amount defaults to 1) sub down { my $sema = shift; + my $dec = @_ ? $validate_arg->(shift) : 1; + lock($$sema); - my $dec = @_ ? shift : 1; - if (! defined($dec) || - ! looks_like_number($dec) || - (int($dec) != $dec) || - ($dec < 1)) - { - require Carp; - $dec = 'undef' if (! defined($dec)); - Carp::croak("Semaphore decrement is not a positive integer: $dec"); - } cond_wait($$sema) until ($$sema >= $dec); $$sema -= $dec; } +# Decrement a semaphore's count only if count >= decrement value +# (decrement amount defaults to 1) +sub down_nb { + my $sema = shift; + my $dec = @_ ? $validate_arg->(shift) : 1; + + lock($$sema); + my $ok = ($$sema >= $dec); + $$sema -= $dec if $ok; + return $ok; +} + +# Decrement a semaphore's count even if the count goes below 0 +# (decrement amount defaults to 1) +sub down_force { + my $sema = shift; + my $dec = @_ ? $validate_arg->(shift) : 1; + + lock($$sema); + $$sema -= $dec; +} + # Increment a semaphore's count (increment amount defaults to 1) sub up { my $sema = shift; + my $inc = @_ ? $validate_arg->(shift) : 1; + lock($$sema); - my $inc = @_ ? shift : 1; - if (! defined($inc) || - ! looks_like_number($inc) || - (int($inc) != $inc) || - ($inc < 1)) + ($$sema += $inc) > 0 and cond_broadcast($$sema); +} + +### Internal Functions ### + +# Validate method argument +$validate_arg = sub { + my $arg = shift; + + if (! defined($arg) || + ! looks_like_number($arg) || + (int($arg) != $arg) || + ($arg < 1)) { require Carp; - $inc = 'undef' if (! defined($inc)); - Carp::croak("Semaphore increment is not a positive integer: $inc"); + my ($method) = (caller(1))[3]; + $method =~ s/Thread::Semaphore:://; + $arg = 'undef' if (! defined($arg)); + Carp::croak("Argument to semaphore method '$method' is not a positive integer: $arg"); } - ($$sema += $inc) > 0 and cond_broadcast($$sema); -} + + return $arg; +}; 1; @@ -66,7 +102,7 @@ Thread::Semaphore - Thread-safe semaphores =head1 VERSION -This document describes Thread::Semaphore version 2.09 +This document describes Thread::Semaphore version 2.11 =head1 SYNOPSIS @@ -76,10 +112,24 @@ This document describes Thread::Semaphore version 2.09 # The guarded section is here $s->up(); # Also known as the semaphore V operation. - # The default semaphore value is 1 + # Decrement the semaphore only if it would immediately succeed. + if ($s->down_nb()) { + # The guarded section is here + $s->up(); + } + + # Forcefully decrement the semaphore even if its count goes below 0. + $s->down_force(); + + # The default value for semaphore operations is 1 my $s = Thread::Semaphore-new($initial_value); $s->down($down_value); $s->up($up_value); + if ($s->down_nb($down_value)) { + ... + $s->up($up_value); + } + $s->down_force($down_value); =head1 DESCRIPTION @@ -119,6 +169,27 @@ This is the semaphore "P operation" (the name derives from the Dutch word "pak", which means "capture" -- the semaphore operations were named by the late Dijkstra, who was Dutch). +=item ->down_nb() + +=item ->down_nb(NUMBER) + +The C method attempts to decrease the semaphore's count by the +specified number (which must be an integer >= 1), or by one if no number +is specified. + +If the semaphore's count would drop below zero, this method will return +I, and the semaphore's count remains unchanged. Otherwise, the +semaphore's count is decremented and this method returns I. + +=item ->down_force() + +=item ->down_force(NUMBER) + +The C method decreases the semaphore's count by the specified +number (which must be an integer >= 1), or by one if no number is specified. +This method does not block, and may cause the semaphore's count to drop +below zero. + =item ->up() =item ->up(NUMBER) @@ -151,7 +222,7 @@ Thread::Semaphore Discussion Forum on CPAN: L Annotated POD for Thread::Semaphore: -L +L Source repository: L diff --git a/dist/Thread-Semaphore/t/02_errs.t b/dist/Thread-Semaphore/t/02_errs.t index 45b0aa9..e336b94 100644 --- a/dist/Thread-Semaphore/t/02_errs.t +++ b/dist/Thread-Semaphore/t/02_errs.t @@ -3,9 +3,9 @@ use warnings; use Thread::Semaphore; -use Test::More 'tests' => 12; +use Test::More 'tests' => 9; -my $err = qr/^Semaphore .* is not .* integer: /; +my $err = qr/^Semaphore initializer is not an integer: /; eval { Thread::Semaphore->new(undef); }; like($@, $err, $@); @@ -17,8 +17,12 @@ like($@, $err, $@); my $s = Thread::Semaphore->new(); ok($s, 'New semaphore'); +$err = qr/^Argument to semaphore method .* is not a positive integer: /; + eval { $s->down(undef); }; like($@, $err, $@); +eval { $s->down(0); }; +like($@, $err, $@); eval { $s->down(-1); }; like($@, $err, $@); eval { $s->down(1.5); }; @@ -26,14 +30,7 @@ like($@, $err, $@); eval { $s->down('foo'); }; like($@, $err, $@); -eval { $s->up(undef); }; -like($@, $err, $@); -eval { $s->up(-1); }; -like($@, $err, $@); -eval { $s->up(1.5); }; -like($@, $err, $@); -eval { $s->up('foo'); }; -like($@, $err, $@); +# No need to test ->up(), etc. as the arg validation code is common to them all exit(0); diff --git a/dist/Thread-Semaphore/t/03_nothreads.t b/dist/Thread-Semaphore/t/03_nothreads.t index f0454be..b8b2f0f 100644 --- a/dist/Thread-Semaphore/t/03_nothreads.t +++ b/dist/Thread-Semaphore/t/03_nothreads.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More 'tests' => 4; +use Test::More 'tests' => 6; use Thread::Semaphore; @@ -13,6 +13,8 @@ $s->up(2); is($$s, 2, 'Non-threaded semaphore'); $s->down(); is($$s, 1, 'Non-threaded semaphore'); +ok(! $s->down_nb(2), 'Non-threaded semaphore'); +ok($s->down_nb(), 'Non-threaded semaphore'); exit(0);