This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Upgrade to Thread::Queue 3.12"
authorJames E Keenan <jkeenan@cpan.org>
Tue, 14 Feb 2017 19:04:54 +0000 (14:04 -0500)
committerJames E Keenan <jkeenan@cpan.org>
Tue, 14 Feb 2017 19:04:54 +0000 (14:04 -0500)
This reverts commit 57c819f845c985ed9979bfa76b1b8ca1708370f0.

Reverting to give us time to explore possible race condition.  See:
https://rt.perl.org/Ticket/Display.html?id=130777

Porting/Maintainers.pl
dist/Thread-Queue/lib/Thread/Queue.pm
dist/Thread-Queue/t/01_basic.t
dist/Thread-Queue/t/02_refs.t
dist/Thread-Queue/t/03_peek.t
dist/Thread-Queue/t/05_extract.t
dist/Thread-Queue/t/06_insert.t
dist/Thread-Queue/t/07_lock.t
dist/Thread-Queue/t/10_timed.t
dist/Thread-Queue/t/11_limit.t

index 2198cf2..9f6bf75 100755 (executable)
@@ -1220,7 +1220,7 @@ use File::Glob qw(:case);
     # correct for this (and Thread::Semaphore, threads, and threads::shared)
     # to be under dist/ rather than cpan/
     'Thread::Queue' => {
     # correct for this (and Thread::Semaphore, threads, and threads::shared)
     # to be under dist/ rather than cpan/
     'Thread::Queue' => {
-        'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.12.tar.gz',
+        'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.11.tar.gz',
         'FILES'        => q[dist/Thread-Queue],
         'EXCLUDED'     => [
             qr{^examples/},
         'FILES'        => q[dist/Thread-Queue],
         'EXCLUDED'     => [
             qr{^examples/},
index c0d2180..9f896b7 100644 (file)
@@ -3,7 +3,7 @@ package Thread::Queue;
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
-our $VERSION = '3.12';
+our $VERSION = '3.11';
 $VERSION = eval $VERSION;
 
 use threads::shared 1.21;
 $VERSION = eval $VERSION;
 
 use threads::shared 1.21;
@@ -65,8 +65,8 @@ sub end
     lock(%$self);
     # No more data is coming
     $$self{'ENDED'} = 1;
     lock(%$self);
     # No more data is coming
     $$self{'ENDED'} = 1;
-
-    cond_signal(%$self);  # Unblock possibly waiting threads
+    # Try to release at least one blocked thread
+    cond_signal(%$self);
 }
 
 # Return 1 or more items from the head of a queue, blocking if needed
 }
 
 # Return 1 or more items from the head of a queue, blocking if needed
@@ -80,21 +80,17 @@ sub dequeue
 
     # Wait for requisite number of items
     cond_wait(%$self) while ((@$queue < $count) && ! $$self{'ENDED'});
 
     # 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
 
     # If no longer blocking, try getting whatever is left on the queue
     return $self->dequeue_nb($count) if ($$self{'ENDED'});
 
     # Return single item
-    if ($count == 1) {
-        my $item = shift(@$queue);
-        cond_signal(%$self);  # Unblock possibly waiting threads
-        return $item;
-    }
+    return shift(@$queue) if ($count == 1);
 
     # Return multiple items
     my @items;
     push(@items, shift(@$queue)) for (1..$count);
 
     # Return multiple items
     my @items;
     push(@items, shift(@$queue)) for (1..$count);
-    cond_signal(%$self);  # Unblock possibly waiting threads
     return @items;
 }
 
     return @items;
 }
 
@@ -108,11 +104,7 @@ sub dequeue_nb
     my $count = @_ ? $self->_validate_count(shift) : 1;
 
     # Return single item
     my $count = @_ ? $self->_validate_count(shift) : 1;
 
     # Return single item
-    if ($count == 1) {
-        my $item = shift(@$queue);
-        cond_signal(%$self);  # Unblock possibly waiting threads
-        return $item;
-    }
+    return shift(@$queue) if ($count == 1);
 
     # Return multiple items
     my @items;
 
     # Return multiple items
     my @items;
@@ -120,7 +112,6 @@ sub dequeue_nb
         last if (! @$queue);
         push(@items, shift(@$queue));
     }
         last if (! @$queue);
         push(@items, shift(@$queue));
     }
-    cond_signal(%$self);  # Unblock possibly waiting threads
     return @items;
 }
 
     return @items;
 }
 
@@ -144,6 +135,7 @@ sub dequeue_timed
     while ((@$queue < $count) && ! $$self{'ENDED'}) {
         last if (! cond_timedwait(%$self, $timeout));
     }
     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);
 
     # Get whatever we need off the queue if available
     return $self->dequeue_nb($count);
@@ -195,7 +187,8 @@ sub insert
     # Add previous items back onto the queue
     push(@$queue, @tmp);
 
     # Add previous items back onto the queue
     push(@$queue, @tmp);
 
-    cond_signal(%$self);  # Unblock possibly waiting threads
+    # Soup's up
+    cond_signal(%$self);
 }
 
 # Remove items from anywhere in a queue
 }
 
 # Remove items from anywhere in a queue
@@ -213,7 +206,7 @@ sub extract
         $index += @$queue;
         if ($index < 0) {
             $count += $index;
         $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
         }
     }
             return $self->dequeue_nb($count);  # Extract from the head
         }
     }
@@ -231,8 +224,6 @@ sub extract
     # Add back any removed items
     push(@$queue, @tmp);
 
     # Add back any removed items
     push(@$queue, @tmp);
 
-    cond_signal(%$self);  # Unblock possibly waiting threads
-
     # Return single item
     return $items[0] if ($count == 1);
 
     # Return single item
     return $items[0] if ($count == 1);
 
@@ -272,19 +263,14 @@ sub _validate_count
     if (! defined($count) ||
         ! looks_like_number($count) ||
         (int($count) != $count) ||
     if (! defined($count) ||
         ! looks_like_number($count) ||
         (int($count) != $count) ||
-        ($count < 1) ||
-        ($$self{'LIMIT'} && $count > $$self{'LIMIT'}))
+        ($count < 1))
     {
         require Carp;
         my ($method) = (caller(1))[3];
         my $class_name = ref($self);
         $method =~ s/$class_name\:://;
         $count = 'undef' if (! defined($count));
     {
         require Carp;
         my ($method) = (caller(1))[3];
         my $class_name = ref($self);
         $method =~ s/$class_name\:://;
         $count = 'undef' if (! defined($count));
-        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");
-        }
+        Carp::croak("Invalid 'count' argument ($count) to '$method' method");
     }
 
     return $count;
     }
 
     return $count;
@@ -318,7 +304,7 @@ Thread::Queue - Thread-safe queues
 
 =head1 VERSION
 
 
 =head1 VERSION
 
-This document describes Thread::Queue version 3.12
+This document describes Thread::Queue version 3.11
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
@@ -508,9 +494,6 @@ C<limit> does not prevent enqueuing items beyond that count:
                          # 'undef')
  $q->limit = 0;          # Queue size is now unlimited
 
                          # '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.
 =item ->end()
 
 Declares that no more items will be added to the queue.
index 2983f0b..4ec5195 100644 (file)
@@ -13,7 +13,7 @@ use threads;
 use Thread::Queue;
 
 if ($] == 5.008) {
 use Thread::Queue;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index 0cebdc1..fdf8f6b 100644 (file)
@@ -14,7 +14,7 @@ use threads::shared;
 use Thread::Queue;
 
 if ($] == 5.008) {
 use Thread::Queue;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index d543b59..29ef75e 100644 (file)
@@ -13,7 +13,7 @@ use threads;
 use Thread::Queue;
 
 if ($] == 5.008) {
 use Thread::Queue;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index de0e78b..d8cb417 100644 (file)
@@ -13,7 +13,7 @@ use threads;
 use Thread::Queue;
 
 if ($] == 5.008) {
 use Thread::Queue;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index 4f9d1df..93617e1 100644 (file)
@@ -13,7 +13,7 @@ use threads;
 use Thread::Queue;
 
 if ($] == 5.008) {
 use Thread::Queue;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index b20e060..6337221 100644 (file)
@@ -14,7 +14,7 @@ use Thread::Queue;
 use Thread::Semaphore;
 
 if ($] == 5.008) {
 use Thread::Semaphore;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index 8404720..da8b03a 100644 (file)
@@ -13,7 +13,7 @@ use threads;
 use Thread::Queue;
 
 if ($] == 5.008) {
 use Thread::Queue;
 
 if ($] == 5.008) {
-    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
+    require './t/test.pl';   # Test::More work-alike for Perl 5.8.0
 } else {
     require Test::More;
 }
 } else {
     require Test::More;
 }
index b84fcc3..1bd88b3 100644 (file)
@@ -19,7 +19,7 @@ use Thread::Queue;
 
 use Test::More;
 
 
 use Test::More;
 
-plan tests => 13;
+plan tests => 8;
 
 my $q = Thread::Queue->new();
 my $rpt = Thread::Queue->new();
 
 my $q = Thread::Queue->new();
 my $rpt = Thread::Queue->new();
@@ -82,12 +82,12 @@ $rpt->enqueue($q->pending);
 # q = (4, 5, 'foo'); r = (4, 3, 4, 3)
 
 # Read all items from queue
 # q = (4, 5, 'foo'); r = (4, 3, 4, 3)
 
 # Read all items from queue
-my @items = $q->dequeue(3);
-is_deeply(\@items, [4, 5, 'foo'], 'Dequeued 3 items');
+my @item = $q->dequeue(3);
+is_deeply(\@item, [4, 5, 'foo'], 'Dequeued 3 items');
 # Thread is now unblocked
 
 # Thread is now unblocked
 
-@items = $q->dequeue(2);
-is_deeply(\@items, [6, 7], 'Dequeued 2 items');
+@item = $q->dequeue(2);
+is_deeply(\@item, [6, 7], 'Dequeued 2 items');
 
 # Thread is now unblocked
 # Handshake with thread
 
 # Thread is now unblocked
 # Handshake with thread
@@ -96,44 +96,6 @@ $rpt->enqueue('go');
 # (7) - Done
 $th->join;
 
 # (7) - Done
 $th->join;
 
-# It's an error to call dequeue methods with COUNT > LIMIT
-eval { $q->dequeue(5); };
-like($@, qr/exceeds queue size limit/, $@);
-
-# Bug #120157
-#  Fix deadlock from combination of dequeue_nb, enqueue and queue size limit
-
-# (1) Fill queue
-$q->enqueue(1..3);
-is($q->pending, 3, 'Queue loaded');
-
-$th = threads->create( sub {
-    $rpt->enqueue('go');
-
-    # (3) Thread blocks trying to add to full queue
-    $q->enqueue(99);
-
-    # (5) Thread exits
-    $rpt->enqueue('done');
-});
-
-# (2) Wait for thread to block on enqueue() call
-is($rpt->dequeue(), 'go', 'Thread blocked');
-threads->yield();
-sleep(1);
-
-# (4) Dequeue items - this will cause thread to unblock
-@items = ();
-while (my $item = $q->dequeue_nb()) {
-    push(@items, $item);
-    threads->yield();
-}
-is_deeply(\@items, [1,2,3,99], 'Dequeued items');
-
-# (6) - Done
-$th->join();
-is($rpt->dequeue(), 'done', 'Thread exited');
-
 exit(0);
 
 # EOF
 exit(0);
 
 # EOF