summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Thread
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2018-03-08 00:16:42 +0000
committerKarl Berry <karl@freefriends.org>2018-03-08 00:16:42 +0000
commit34a8597760ab5740abd49b6d8be10e1876f5ce98 (patch)
tree099a794912a28b3ebbc857961643ba29b28e674a /Master/tlpkg/tlperl/lib/Thread
parent2ca3610031316a7312d046d3ae4c783452831216 (diff)
(tl)perl 5.26.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@46882 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Thread')
-rw-r--r--Master/tlpkg/tlperl/lib/Thread/Queue.pm50
-rw-r--r--Master/tlpkg/tlperl/lib/Thread/Semaphore.pm46
2 files changed, 77 insertions, 19 deletions
diff --git a/Master/tlpkg/tlperl/lib/Thread/Queue.pm b/Master/tlpkg/tlperl/lib/Thread/Queue.pm
index 2f87eed9c73..c0d21806536 100644
--- a/Master/tlpkg/tlperl/lib/Thread/Queue.pm
+++ b/Master/tlpkg/tlperl/lib/Thread/Queue.pm
@@ -3,7 +3,7 @@ package Thread::Queue;
use strict;
use warnings;
-our $VERSION = '3.09';
+our $VERSION = '3.12';
$VERSION = eval $VERSION;
use threads::shared 1.21;
@@ -65,8 +65,8 @@ sub end
lock(%$self);
# No more data is coming
$$self{'ENDED'} = 1;
- # Try to release at least one blocked thread
- cond_signal(%$self);
+
+ cond_signal(%$self); # Unblock possibly waiting threads
}
# Return 1 or more items from the head of a queue, blocking if needed
@@ -80,17 +80,21 @@ sub dequeue
# Wait for requisite number of items
cond_wait(%$self) while ((@$queue < $count) && ! $$self{'ENDED'});
- cond_signal(%$self) if ((@$queue >= $count) || $$self{'ENDED'});
# If no longer blocking, try getting whatever is left on the queue
return $self->dequeue_nb($count) if ($$self{'ENDED'});
# Return single item
- return shift(@$queue) if ($count == 1);
+ if ($count == 1) {
+ my $item = shift(@$queue);
+ cond_signal(%$self); # Unblock possibly waiting threads
+ return $item;
+ }
# Return multiple items
my @items;
push(@items, shift(@$queue)) for (1..$count);
+ cond_signal(%$self); # Unblock possibly waiting threads
return @items;
}
@@ -104,7 +108,11 @@ sub dequeue_nb
my $count = @_ ? $self->_validate_count(shift) : 1;
# Return single item
- return shift(@$queue) if ($count == 1);
+ if ($count == 1) {
+ my $item = shift(@$queue);
+ cond_signal(%$self); # Unblock possibly waiting threads
+ return $item;
+ }
# Return multiple items
my @items;
@@ -112,6 +120,7 @@ sub dequeue_nb
last if (! @$queue);
push(@items, shift(@$queue));
}
+ cond_signal(%$self); # Unblock possibly waiting threads
return @items;
}
@@ -135,7 +144,6 @@ sub dequeue_timed
while ((@$queue < $count) && ! $$self{'ENDED'}) {
last if (! cond_timedwait(%$self, $timeout));
}
- cond_signal(%$self) if ((@$queue >= $count) || $$self{'ENDED'});
# Get whatever we need off the queue if available
return $self->dequeue_nb($count);
@@ -187,8 +195,7 @@ sub insert
# Add previous items back onto the queue
push(@$queue, @tmp);
- # Soup's up
- cond_signal(%$self);
+ cond_signal(%$self); # Unblock possibly waiting threads
}
# Remove items from anywhere in a queue
@@ -206,7 +213,7 @@ sub extract
$index += @$queue;
if ($index < 0) {
$count += $index;
- return if ($count <= 0); # Beyond the head of the queue
+ return if ($count <= 0); # Beyond the head of the queue
return $self->dequeue_nb($count); # Extract from the head
}
}
@@ -224,6 +231,8 @@ sub extract
# Add back any removed items
push(@$queue, @tmp);
+ cond_signal(%$self); # Unblock possibly waiting threads
+
# Return single item
return $items[0] if ($count == 1);
@@ -263,14 +272,19 @@ sub _validate_count
if (! defined($count) ||
! looks_like_number($count) ||
(int($count) != $count) ||
- ($count < 1))
+ ($count < 1) ||
+ ($$self{'LIMIT'} && $count > $$self{'LIMIT'}))
{
require Carp;
my ($method) = (caller(1))[3];
my $class_name = ref($self);
$method =~ s/$class_name\:://;
$count = 'undef' if (! defined($count));
- Carp::croak("Invalid 'count' argument ($count) to '$method' method");
+ if ($$self{'LIMIT'} && $count > $$self{'LIMIT'}) {
+ Carp::croak("'count' argument ($count) to '$method' method exceeds queue size limit ($$self{'LIMIT'})");
+ } else {
+ Carp::croak("Invalid 'count' argument ($count) to '$method' method");
+ }
}
return $count;
@@ -304,7 +318,7 @@ Thread::Queue - Thread-safe queues
=head1 VERSION
-This document describes Thread::Queue version 3.09
+This document describes Thread::Queue version 3.12
=head1 SYNOPSIS
@@ -494,6 +508,9 @@ C<limit> does not prevent enqueuing items beyond that count:
# 'undef')
$q->limit = 0; # Queue size is now unlimited
+Calling any of the dequeue methods with C<COUNT> greater than a queue's
+C<limit> will generate an error.
+
=item ->end()
Declares that no more items will be added to the queue.
@@ -618,8 +635,11 @@ Passing array/hash refs that contain objects may not work for Perl prior to
=head1 SEE ALSO
-Thread::Queue Discussion Forum on CPAN:
-L<http://www.cpanforum.com/dist/Thread-Queue>
+Thread::Queue on MetaCPAN:
+L<https://metacpan.org/release/Thread-Queue>
+
+Code repository for CPAN distribution:
+L<https://github.com/Dual-Life/Thread-Queue>
L<threads>, L<threads::shared>
diff --git a/Master/tlpkg/tlperl/lib/Thread/Semaphore.pm b/Master/tlpkg/tlperl/lib/Thread/Semaphore.pm
index d940d031bf4..0154798e224 100644
--- a/Master/tlpkg/tlperl/lib/Thread/Semaphore.pm
+++ b/Master/tlpkg/tlperl/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>>