In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/51068c1406a3db6f7be27d5041ff91444bac8886?hp=c2f7c0b6d5a35f13947e3a4bde995fd56bf6a5ae>
- Log -----------------------------------------------------------------
commit 51068c1406a3db6f7be27d5041ff91444bac8886
Author: jdhedden <jdhed...@cpan.org>
Date: Sat Aug 27 09:01:40 2016 -0400
Upgrade to Thread::Semaphore 2.13
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
Porting/Maintainers.pl | 2 +-
dist/Thread-Semaphore/lib/Thread/Semaphore.pm | 46 ++++++++++++++++++++--
dist/Thread-Semaphore/t/01_basic.t | 6 +--
dist/Thread-Semaphore/t/03_nothreads.t | 3 +-
dist/Thread-Semaphore/t/05_force.t | 5 +--
dist/Thread-Semaphore/t/{01_basic.t => 06_timed.t} | 18 ++++-----
7 files changed, 58 insertions(+), 23 deletions(-)
copy dist/Thread-Semaphore/t/{01_basic.t => 06_timed.t} (84%)
diff --git a/MANIFEST b/MANIFEST
index 195a6cb..5635685 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3609,6 +3609,7 @@ 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/Thread-Semaphore/t/06_timed.t Thread::Semaphore tests
dist/threads/hints/hpux.pl Hint file for HPUX
dist/threads/hints/linux.pl Hint file for Linux
dist/threads/lib/threads.pm ithreads
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index f0b598b..945017b 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1224,7 +1224,7 @@ use File::Glob qw(:case);
},
'Thread::Semaphore' => {
- 'DISTRIBUTION' => 'JDHEDDEN/Thread-Semaphore-2.12.tar.gz',
+ 'DISTRIBUTION' => 'JDHEDDEN/Thread-Semaphore-2.13.tar.gz',
'FILES' => q[dist/Thread-Semaphore],
'EXCLUDED' => [
qw( examples/semaphore.pl
diff --git a/dist/Thread-Semaphore/lib/Thread/Semaphore.pm
b/dist/Thread-Semaphore/lib/Thread/Semaphore.pm
index d940d03..0154798 100644
--- a/dist/Thread-Semaphore/lib/Thread/Semaphore.pm
+++ b/dist/Thread-Semaphore/lib/Thread/Semaphore.pm
@@ -3,7 +3,7 @@ package Thread::Semaphore;
use strict;
use warnings;
-our $VERSION = '2.12';
+our $VERSION = '2.13';
$VERSION = eval $VERSION;
use threads::shared;
@@ -64,6 +64,22 @@ sub down_force {
$$sema -= $dec;
}
+# Decrement a semaphore's count with timeout
+# (timeout in seconds; decrement amount defaults to 1)
+sub down_timed {
+ my $sema = shift;
+ my $timeout = $validate_arg->(shift);
+ my $dec = @_ ? $validate_arg->(shift) : 1;
+
+ lock($$sema);
+ my $abs = time() + $timeout;
+ until ($$sema >= $dec) {
+ return if !cond_timedwait($$sema, $abs);
+ }
+ $$sema -= $dec;
+ return 1;
+}
+
# Increment a semaphore's count (increment amount defaults to 1)
sub up {
my $sema = shift;
@@ -102,7 +118,7 @@ Thread::Semaphore - Thread-safe semaphores
=head1 VERSION
-This document describes Thread::Semaphore version 2.12
+This document describes Thread::Semaphore version 2.13
=head1 SYNOPSIS
@@ -190,6 +206,23 @@ 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 ->down_timed(TIMEOUT)
+
+=item ->down_timed(TIMEOUT, NUMBER)
+
+The C<down_timed> method attempts to decrease the semaphore's count by 1
+or by the specified number within the specified timeout period given in
+seconds (which must be an integer >= 0).
+
+If the semaphore's count would drop below zero, this method will block
+until either the semaphore's count is greater than or equal to the
+amount you're C<down>ing the semaphore's count by, or until the timeout is
+reached.
+
+If the timeout is reached, this method will return I<false>, and the
+semaphore's count remains unchanged. Otherwise, the semaphore's count is
+decremented and this method returns I<true>.
+
=item ->up()
=item ->up(NUMBER)
@@ -218,11 +251,16 @@ environment.
=head1 SEE ALSO
-Thread::Semaphore Discussion Forum on CPAN:
-L<http://www.cpanforum.com/dist/Thread-Semaphore>
+Thread::Semaphore on MetaCPAN:
+L<https://metacpan.org/release/Thread-Semaphore>
+
+Code repository for CPAN distribution:
+L<https://github.com/Dual-Life/Thread-Semaphore>
L<threads>, L<threads::shared>
+Sample code in the I<examples> directory of this distribution on CPAN.
+
=head1 MAINTAINER
Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>
diff --git a/dist/Thread-Semaphore/t/01_basic.t
b/dist/Thread-Semaphore/t/01_basic.t
index b10f725..1e9d110 100644
--- a/dist/Thread-Semaphore/t/01_basic.t
+++ b/dist/Thread-Semaphore/t/01_basic.t
@@ -35,7 +35,6 @@ my @threads;
push @threads, threads->create(sub {
$st->down();
is($token++, 1, 'Thread 1 got semaphore');
- $st->up();
$sm->up();
$st->down(4);
@@ -46,7 +45,6 @@ push @threads, threads->create(sub {
push @threads, threads->create(sub {
$st->down(2);
is($token++, 3, 'Thread 2 got semaphore');
- $st->up();
$sm->up();
$st->down(4);
@@ -68,11 +66,11 @@ $st->up(9);
$sm->down(2);
$st->down();
-ok(1, 'Main done');
-threads::yield();
$_->join for @threads;
+ok(1, 'Main done');
+
exit(0);
# EOF
diff --git a/dist/Thread-Semaphore/t/03_nothreads.t
b/dist/Thread-Semaphore/t/03_nothreads.t
index b8b2f0f..92dacec 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' => 6;
+use Test::More 'tests' => 7;
use Thread::Semaphore;
@@ -15,6 +15,7 @@ $s->down();
is($$s, 1, 'Non-threaded semaphore');
ok(! $s->down_nb(2), 'Non-threaded semaphore');
ok($s->down_nb(), 'Non-threaded semaphore');
+ok(! $s->down_timed(1), 'Non-threaded semaphore');
exit(0);
diff --git a/dist/Thread-Semaphore/t/05_force.t
b/dist/Thread-Semaphore/t/05_force.t
index 8803cfa..ca888d8 100644
--- a/dist/Thread-Semaphore/t/05_force.t
+++ b/dist/Thread-Semaphore/t/05_force.t
@@ -51,11 +51,10 @@ $st->up();
$sm->down();
is($token, 4, 'Main re-got semaphore');
-ok(1, 'Main done');
-threads::yield();
-
$thread->join;
+ok(1, 'Main done');
+
exit(0);
# EOF
diff --git a/dist/Thread-Semaphore/t/01_basic.t
b/dist/Thread-Semaphore/t/06_timed.t
similarity index 84%
copy from dist/Thread-Semaphore/t/01_basic.t
copy to dist/Thread-Semaphore/t/06_timed.t
index b10f725..11f6759 100644
--- a/dist/Thread-Semaphore/t/01_basic.t
+++ b/dist/Thread-Semaphore/t/06_timed.t
@@ -33,24 +33,22 @@ my $token :shared = 0;
my @threads;
push @threads, threads->create(sub {
- $st->down();
+ $st->down_timed(3);
is($token++, 1, 'Thread 1 got semaphore');
- $st->up();
$sm->up();
- $st->down(4);
+ $st->down_timed(3, 4);
is($token, 5, 'Thread 1 done');
$sm->up();
});
push @threads, threads->create(sub {
- $st->down(2);
+ $st->down_timed(3, 2);
is($token++, 3, 'Thread 2 got semaphore');
- $st->up();
$sm->up();
- $st->down(4);
- is($token, 5, 'Thread 2 done');
+ # Force timeout by asking for more than will ever show up
+ ok(! $st->down_timed(1, 10), 'Thread 2 timed out');
$sm->up();
});
@@ -64,15 +62,15 @@ $st->up(2);
$sm->down();
is($token++, 4, 'Main re-got semaphore');
-$st->up(9);
+$st->up(5);
$sm->down(2);
$st->down();
-ok(1, 'Main done');
-threads::yield();
$_->join for @threads;
+ok(1, 'Main done');
+
exit(0);
# EOF
--
Perl5 Master Repository
