Upgrade to Thread::Semaphore 2.13

7 files changed, 126 insertions, 13 deletions

diff --git a/MANIFEST b/MANIFEST
index 195a6cb07a..5635685c99 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 f0b598b333..945017ba45 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 d940d031bf..0154798e22 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 b10f7254fb..1e9d110680 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 b8b2f0f227..92dacec014 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 8803cfa160..ca888d816b 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/06_timed.t b/dist/Thread-Semaphore/t/06_timed.t
new file mode 100644
index 0000000000..11f675981f
--- /dev/null
+++ b/dist/Thread-Semaphore/t/06_timed.t
@@ -0,0 +1,76 @@
+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' => 10);
+
+### Basic usage with multiple threads ###
+
+my $sm = Thread::Semaphore->new();
+my $st = Thread::Semaphore->new(0);
+ok($sm, 'New Semaphore');
+ok($st, 'New Semaphore');
+
+my $token :shared = 0;
+
+my @threads;
+
+push @threads, threads->create(sub {
+    $st->down_timed(3);
+    is($token++, 1, 'Thread 1 got semaphore');
+    $sm->up();
+
+    $st->down_timed(3, 4);
+    is($token, 5, 'Thread 1 done');
+    $sm->up();
+});
+
+push @threads, threads->create(sub {
+    $st->down_timed(3, 2);
+    is($token++, 3, 'Thread 2 got semaphore');
+    $sm->up();
+
+    # Force timeout by asking for more than will ever show up
+    ok(! $st->down_timed(1, 10), 'Thread 2 timed out');
+    $sm->up();
+});
+
+$sm->down();
+is($token++, 0, 'Main has semaphore');
+$st->up();
+
+$sm->down();
+is($token++, 2, 'Main got semaphore');
+$st->up(2);
+
+$sm->down();
+is($token++, 4, 'Main re-got semaphore');
+$st->up(5);
+
+$sm->down(2);
+$st->down();
+
+$_->join for @threads;
+
+ok(1, 'Main done');
+
+exit(0);
+
+# EOF