search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.98k stars 559 forks source link

[PATCH] Upgrade to Thread::Queue 3.12 #15872

Closed p5pRT closed 7 years ago

p5pRT commented 7 years ago

Migrated from rt.perl.org#130777 (status was 'resolved')

Searchable as RT130777$

p5pRT commented 7 years ago

From @jdhedden

This is a bug report for perl from jdhedden@​cpan.org\, generated with the help of perlbug 1.40 running under perl 5.24.1.

The attached patch upgrades 'Thread​::Queue' to version 3.12.

This is a fix from Chad Fox (chad@​gigapogo.com) for [rt.cpan.org #120157] deadlock using dequeue_nb on size limited queue https://rt.cpan.org/Ticket/Display.html?id=120157

Flags​:   category=library   severity=low   Type=Patch   PatchStatus=HasPatch   module=Thread​::Queue

Site configuration information for perl 5.24.1​:

Configured by Debian Project at Sun Jan 15 23​:35​:20 UTC 2017.

Summary of my perl5 (revision 5 version 24 subversion 1) configuration​:  
  Platform​:   osname=linux\, osvers=3.16.0\, archname=x86_64-linux-gnu-thread-multi   uname='linux localhost 3.16.0 #1 smp debian 3.16.0 x86_64 gnulinux '   config_args='-Dusethreads -Duselargefiles -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time -D_FORTIFY_SOURCE=2 -g -O2 -fdebug-prefix-map=/build/perl-eDFQz3/perl-5.24.1=. -fstack-protector-strong -Wformat -Werror=format-security -Dldflags= -Wl\,-z\,relro -Dlddlflags=-shared -Wl\,-z\,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.24 -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.24 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.24 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.24.1 -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.24.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dusesitecustomize -Duse64bitint -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.24.1'   hint=recommended\, useposix=true\, d_sigaction=define   useithreads=define\, usemultiplicity=define   use64bitint=define\, use64bitall=define\, uselongdouble=undef   usemymalloc=n\, bincompat5005=undef   Compiler​:   cc='x86_64-linux-gnu-gcc'\, ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'\,   optimize='-O2 -g'\,   cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include'   ccversion=''\, gccversion='6.3.0 20161229'\, gccosandvers=''   intsize=4\, longsize=8\, ptrsize=8\, doublesize=8\, byteorder=12345678\, doublekind=3   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=16\, longdblkind=3   ivtype='long'\, ivsize=8\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=8   alignbytes=8\, prototype=define   Linker and Libraries​:   ld='x86_64-linux-gnu-gcc'\, ldflags =' -fstack-protector-strong -L/usr/local/lib'   libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/6/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib   libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt   perllibs=-ldl -lm -lpthread -lc -lcrypt   libc=libc-2.24.so\, so=so\, useshrplib=true\, libperl=libperl.so.5.24   gnulibc_version='2.24'   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='-Wl\,-E'   cccdlflags='-fPIC'\, lddlflags='-shared -L/usr/local/lib -fstack-protector-strong'

Locally applied patches​:   DEBPKG​:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.   DEBPKG​:debian/db_file_ver - https://bugs.debian.org/340047 Remove overly restrictive DB_File version check.   DEBPKG​:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.   DEBPKG​:debian/enc2xs_inc - https://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @​INC directories.   DEBPKG​:debian/errno_ver - https://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.   DEBPKG​:debian/libperl_embed_doc - https://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking   DEBPKG​:fixes/respect_umask - Respect umask during installation   DEBPKG​:debian/writable_site_dirs - Set umask approproately for site install directories   DEBPKG​:debian/extutils_set_libperl_path - EU​:MM​: set location of libperl.a under /usr/lib   DEBPKG​:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor   DEBPKG​:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.   DEBPKG​:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.   DEBPKG​:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.   DEBPKG​:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.   DEBPKG​:debian/mod_paths - Tweak @​INC ordering for Debian   DEBPKG​:debian/prune_libs - https://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.   DEBPKG​:fixes/net_smtp_docs - [rt.cpan.org #36038] https://bugs.debian.org/100195 Document the Net​::SMTP 'Port' option   DEBPKG​:debian/perlivp - https://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local   DEBPKG​:debian/deprecate-with-apt - https://bugs.debian.org/747628 Point users to Debian packages of deprecated core modules   DEBPKG​:debian/squelch-locale-warnings - https://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts   DEBPKG​:debian/skip-upstream-git-tests - Skip tests specific to the upstream Git repository   DEBPKG​:debian/patchlevel - https://bugs.debian.org/567489 List packaged patches for 5.24.1-1 in patchlevel.h   DEBPKG​:debian/skip-kfreebsd-crash - https://bugs.debian.org/628493 [perl #96272] Skip a crashing test case in t/op/threads.t on GNU/kFreeBSD   DEBPKG​:fixes/document_makemaker_ccflags - https://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}   DEBPKG​:debian/find_html2text - https://bugs.debian.org/640479 Configure CPAN​::Distribution with correct name of html2text   DEBPKG​:debian/perl5db-x-terminal-emulator.patch - https://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl   DEBPKG​:debian/cpan-missing-site-dirs - https://bugs.debian.org/688842 Fix CPAN​::FirstTime defaults with nonexisting site dirs if a parent is writable   DEBPKG​:fixes/memoize_storable_nstore - [rt.cpan.org #77790] https://bugs.debian.org/587650 Memoize​::Storable​: respect 'nstore' option not respected   DEBPKG​:debian/regen-skip - Skip a regeneration check in unrelated git repositories   DEBPKG​:debian/makemaker-pasthru - https://bugs.debian.org/758471 Pass LD settings through to subdirectories   DEBPKG​:debian/makemaker-manext - https://bugs.debian.org/247370 Make EU​::MakeMaker honour MANnEXT settings in generated manpage headers   DEBPKG​:debian/devel-ppport-reproducibility - https://bugs.debian.org/801523 Sort the list of XS code files when generating RealPPPort.xs   DEBPKG​:debian/encode-unicode-bom-doc - https://bugs.debian.org/798727 Document Debian backport of Encode​::Unicode fix   DEBPKG​:debian/kfreebsd-softupdates - https://bugs.debian.org/796798 Work around Debian Bug#796798   DEBPKG​:fixes/autodie-scope - https://bugs.debian.org/798096 Fix a scoping issue with "no autodie" and the "system" sub   DEBPKG​:fixes/crosscompile-no-targethost - [23695c0] [perl #127234] Fix the Configure escape with usecrosscompile but no targethost   DEBPKG​:fixes/memoize-pod - [rt.cpan.org #89441] Fix POD errors in Memoize   DEBPKG​:fixes/ok-pod - Added encoding for pod.   DEBPKG​:debian/hurd-softupdates - https://bugs.debian.org/822735 Fix t/op/stat.t failures on hurd   DEBPKG​:fixes/nntp_docs - https://bugs.debian.org/51962 Net​::NNTP​: Correct innd/nnrpd confusion in relation to Reader option   DEBPKG​:fixes/math_complex_doc_great_circle - https://bugs.debian.org/697567 [rt.cpan.org #114104] Math​::Trig​: clarify definition of great_circle_midpoint   DEBPKG​:fixes/math_complex_doc_see_also - https://bugs.debian.org/697568 [rt.cpan.org #114105] Math​::Trig​: add missing SEE ALSO   DEBPKG​:fixes/math_complex_doc_angle_units - https://bugs.debian.org/731505 [rt.cpan.org #114106] Math​::Trig​: document angle units   DEBPKG​:fixes/cpan_web_link - https://bugs.debian.org/367291 CPAN​: Add link to main CPAN web site   DEBPKG​:fixes/time_piece_doc - https://bugs.debian.org/817925 Time​::Piece​: Improve documentation for add_months and add_years   DEBPKG​:fixes/perlbug-refactor - https://bugs.debian.org/822463 [perl #128020] perlbug​: Refactor duplicated file reading code   DEBPKG​:fixes/perlbug-linewrap - https://bugs.debian.org/822463 [perl #128020] perlbug​: wrap overly long lines   DEBPKG​:fixes/hurd_sigaction - https://bugs.debian.org/825016 [d54f4ed] ext/POSIX/t/sigaction.t​: Skip uid and pid tests on GNU/Hurd   DEBPKG​:fixes/hurd_hints - [4694301] https://bugs.debian.org/825020 [perl #128279] Modify hints for Hurd per Debian ticket 825020.   DEBPKG​:fixes/extutils-parsexs-reproducibility - [perl #128517] https://bugs.debian.org/829296 Make the output of ExtUtils​::ParseXS reproducible   DEBPKG​:debian/CVE-2016-1238/sitecustomize-in-etc - Look for sitecustomize.pl in /etc/perl rather than sitelib on Debian systems   DEBPKG​:debian/CVE-2016-1238/test-suite-without-dot - [perl #127810] Patch unit tests to explicitly insert "." into @​INC when needed.   DEBPKG​:debian/CVE-2016-1238/eumm-without-dot - [perl #127810] Add PERL_USE_UNSAFE_INC support to EU​::MM for fortify_inc support.   DEBPKG​:debian/CVE-2016-1238/cpan-without-dot - [perl #127810] Set PERL_USE_UNSAFE_INC for cpan usage   DEBPKG​:debian/document_inc_removal - Document in perlvar that we remove '.' from @​INC by default   DEBPKG​:fixes/extutils_makemaker_reproducible - https​://bugs.debian.org/835815 https://bugs.debian.org/834190 Make perllocal.pod files reproducible   DEBPKG​:debian/CVE-2016-1238/remove-inc-test - Remove test for '.' in @​INC as it might not be   DEBPKG​:debian/customized - Update customized.dat for files patched in Debian   DEBPKG​:fixes/file_path_hurd_errno - File-Path​: Fix test failure in Hurd due to hard-coded ENOENT   DEBPKG​:debian/hppa_op_optimize_workaround - https://bugs.debian.org/838613 Temporarily lower the optimization of op.c on hppa due to gcc-6 problems   DEBPKG​:fixes/test-builder-warning - https://bugs.debian.org/840968 Silence a 'used only once' warning in Test​::Builder   DEBPKG​:fixes/longdblinf-randomness - [dd68853] [perl #130133] https://bugs.debian.org/844752 Configure​: fix garbage filtering with 80-bit long doubles   DEBPKG​:debian/installman-utf8 - https://bugs.debian.org/840211 Generate man pages with UTF-8 characters

@​INC for perl 5.24.1​:   /etc/perl   /usr/local/lib/x86_64-linux-gnu/perl/5.24.1   /usr/local/share/perl/5.24.1   /usr/lib/x86_64-linux-gnu/perl5/5.24   /usr/share/perl5   /usr/lib/x86_64-linux-gnu/perl/5.24   /usr/share/perl/5.24   /usr/local/lib/site_perl   /usr/lib/x86_64-linux-gnu/perl-base

Environment for perl 5.24.1​:   HOME=/home/jdhedden   LANG=C   LANGUAGE=C   LC_ALL=C   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/home/jdhedden/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/games   PERLIO=perlio   PERL_BADLANG (unset)   SHELL=/bin/bash

p5pRT commented 7 years ago

From @jdhedden

0001-Upgrade-to-Thread-Queue-3.12.patch ```diff From 5874b191922436eb07b210569ef904302b61c94d Mon Sep 17 00:00:00 2001 From: jdhedden Date: Mon, 13 Feb 2017 19:46:37 -0500 Subject: [PATCH] Upgrade to Thread::Queue 3.12 --- Porting/Maintainers.pl | 2 +- dist/Thread-Queue/lib/Thread/Queue.pm | 43 +++++++++++++++++++++---------- dist/Thread-Queue/t/01_basic.t | 2 +- dist/Thread-Queue/t/02_refs.t | 2 +- dist/Thread-Queue/t/03_peek.t | 2 +- dist/Thread-Queue/t/05_extract.t | 2 +- dist/Thread-Queue/t/06_insert.t | 2 +- dist/Thread-Queue/t/07_lock.t | 2 +- dist/Thread-Queue/t/10_timed.t | 2 +- dist/Thread-Queue/t/11_limit.t | 48 +++++++++++++++++++++++++++++++---- 10 files changed, 81 insertions(+), 26 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9f6bf75d55..2198cf2208 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -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' => { - 'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.11.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.12.tar.gz', 'FILES' => q[dist/Thread-Queue], 'EXCLUDED' => [ qr{^examples/}, diff --git a/dist/Thread-Queue/lib/Thread/Queue.pm b/dist/Thread-Queue/lib/Thread/Queue.pm index 9f896b72ea..c0d2180653 100644 --- a/dist/Thread-Queue/lib/Thread/Queue.pm +++ b/dist/Thread-Queue/lib/Thread/Queue.pm @@ -3,7 +3,7 @@ package Thread::Queue; use strict; use warnings; -our $VERSION = '3.11'; +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.11 +This document describes Thread::Queue version 3.12 =head1 SYNOPSIS @@ -494,6 +508,9 @@ C 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 greater than a queue's +C will generate an error. + =item ->end() Declares that no more items will be added to the queue. diff --git a/dist/Thread-Queue/t/01_basic.t b/dist/Thread-Queue/t/01_basic.t index 4ec51957ae..2983f0b700 100644 --- a/dist/Thread-Queue/t/01_basic.t +++ b/dist/Thread-Queue/t/01_basic.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/02_refs.t b/dist/Thread-Queue/t/02_refs.t index fdf8f6bad2..0cebdc1db3 100644 --- a/dist/Thread-Queue/t/02_refs.t +++ b/dist/Thread-Queue/t/02_refs.t @@ -14,7 +14,7 @@ use threads::shared; 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; } diff --git a/dist/Thread-Queue/t/03_peek.t b/dist/Thread-Queue/t/03_peek.t index 29ef75e7fe..d543b59469 100644 --- a/dist/Thread-Queue/t/03_peek.t +++ b/dist/Thread-Queue/t/03_peek.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/05_extract.t b/dist/Thread-Queue/t/05_extract.t index d8cb417be9..de0e78bfd0 100644 --- a/dist/Thread-Queue/t/05_extract.t +++ b/dist/Thread-Queue/t/05_extract.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/06_insert.t b/dist/Thread-Queue/t/06_insert.t index 93617e13a3..4f9d1dff5e 100644 --- a/dist/Thread-Queue/t/06_insert.t +++ b/dist/Thread-Queue/t/06_insert.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/07_lock.t b/dist/Thread-Queue/t/07_lock.t index 633722103c..b20e0604ca 100644 --- a/dist/Thread-Queue/t/07_lock.t +++ b/dist/Thread-Queue/t/07_lock.t @@ -14,7 +14,7 @@ use Thread::Queue; 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; } diff --git a/dist/Thread-Queue/t/10_timed.t b/dist/Thread-Queue/t/10_timed.t index da8b03a7eb..8404720ed6 100644 --- a/dist/Thread-Queue/t/10_timed.t +++ b/dist/Thread-Queue/t/10_timed.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/11_limit.t b/dist/Thread-Queue/t/11_limit.t index 1bd88b39a1..b84fcc3662 100644 --- a/dist/Thread-Queue/t/11_limit.t +++ b/dist/Thread-Queue/t/11_limit.t @@ -19,7 +19,7 @@ use Thread::Queue; use Test::More; -plan tests => 8; +plan tests => 13; 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 -my @item = $q->dequeue(3); -is_deeply(\@item, [4, 5, 'foo'], 'Dequeued 3 items'); +my @items = $q->dequeue(3); +is_deeply(\@items, [4, 5, 'foo'], 'Dequeued 3 items'); # Thread is now unblocked -@item = $q->dequeue(2); -is_deeply(\@item, [6, 7], 'Dequeued 2 items'); +@items = $q->dequeue(2); +is_deeply(\@items, [6, 7], 'Dequeued 2 items'); # Thread is now unblocked # Handshake with thread @@ -96,6 +96,44 @@ $rpt->enqueue('go'); # (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 -- 2.11.0 ```
p5pRT commented 7 years ago

From @jkeenan

On Tue\, 14 Feb 2017 00​:52​:17 GMT\, jdhedden@​cpan.org wrote​:

This is a bug report for perl from jdhedden@​cpan.org\, generated with the help of perlbug 1.40 running under perl 5.24.1.

The attached patch upgrades 'Thread​::Queue' to version 3.12.

This is a fix from Chad Fox (chad@​gigapogo.com) for [rt.cpan.org #120157] deadlock using dequeue_nb on size limited queue https://rt.cpan.org/Ticket/Display.html?id=120157

Thanks\, pushed to blead in commit 57c819f845c985ed9979bfa76b1b8ca1708370f0.

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 7 years ago

The RT System itself - Status changed from 'new' to 'open'

p5pRT commented 7 years ago

@jkeenan - Status changed from 'open' to 'resolved'

p5pRT commented 7 years ago

From @jkeenan

Jerry\,

I am re-opening this ticket because I believe the race condition you alluded to is still present.

Please see this smoke-test report​:

http​://perl5.test-smoke.org/report/53982

Whenever I see a row of 'X' results\, I suspect a problem which appears when running tests in parallel. I then examine the log which smokecurrent.sh generates. Because this log is large\, I'll email you the complete log but only attach excerpts here. These excerpts show the same failure in dist/Thread-Queue/t/11_limit.t that I observed in RT #130752.

AFAICT\, the only significant change you made between the patch submitted in https://rt-archive.perl.org/perl5/Ticket/Display.html?id=130752 and the patch submitted in this ticket (which I applied) was the addition of one line to a test file -- that is\, there was no change in source code. So I suspect a deeper problem.

Can you investigate?

Thank you very much. -- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 7 years ago

From @jkeenan

57c819f.excerpts.smokecurrent.log

p5pRT commented 7 years ago

@jkeenan - Status changed from 'resolved' to 'open'

p5pRT commented 7 years ago

From @jkeenan

Reverted from blead in​:

commit 5376c9c46602f4cb47b306edc76c03bc8500e61f

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 7 years ago

From [Unknown Contact. See original ticket]

Reverted from blead in​:

commit 5376c9c46602f4cb47b306edc76c03bc8500e61f

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 7 years ago

From @jdhedden

Third time's a charm. See attached.

p5pRT commented 7 years ago

From @jdhedden

0001-Upgrade-to-Thread-Queue-3.12.patch ```diff From 666258c8aa8438906ca6a1572a4ce4503cfacf39 Mon Sep 17 00:00:00 2001 From: jdhedden Date: Tue, 14 Feb 2017 23:56:20 -0500 Subject: [PATCH] Upgrade to Thread::Queue 3.12 --- Porting/Maintainers.pl | 2 +- dist/Thread-Queue/lib/Thread/Queue.pm | 43 ++++++++++++++++++++++++----------- dist/Thread-Queue/t/01_basic.t | 2 +- dist/Thread-Queue/t/02_refs.t | 2 +- dist/Thread-Queue/t/03_peek.t | 2 +- dist/Thread-Queue/t/05_extract.t | 2 +- dist/Thread-Queue/t/06_insert.t | 2 +- dist/Thread-Queue/t/07_lock.t | 2 +- dist/Thread-Queue/t/10_timed.t | 2 +- dist/Thread-Queue/t/11_limit.t | 41 +++++++++++++++++++++++++++++---- 10 files changed, 74 insertions(+), 26 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9f6bf75d55..2198cf2208 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -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' => { - 'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.11.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.12.tar.gz', 'FILES' => q[dist/Thread-Queue], 'EXCLUDED' => [ qr{^examples/}, diff --git a/dist/Thread-Queue/lib/Thread/Queue.pm b/dist/Thread-Queue/lib/Thread/Queue.pm index 9f896b72ea..c0d2180653 100644 --- a/dist/Thread-Queue/lib/Thread/Queue.pm +++ b/dist/Thread-Queue/lib/Thread/Queue.pm @@ -3,7 +3,7 @@ package Thread::Queue; use strict; use warnings; -our $VERSION = '3.11'; +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.11 +This document describes Thread::Queue version 3.12 =head1 SYNOPSIS @@ -494,6 +508,9 @@ C 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 greater than a queue's +C will generate an error. + =item ->end() Declares that no more items will be added to the queue. diff --git a/dist/Thread-Queue/t/01_basic.t b/dist/Thread-Queue/t/01_basic.t index 4ec51957ae..2983f0b700 100644 --- a/dist/Thread-Queue/t/01_basic.t +++ b/dist/Thread-Queue/t/01_basic.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/02_refs.t b/dist/Thread-Queue/t/02_refs.t index fdf8f6bad2..0cebdc1db3 100644 --- a/dist/Thread-Queue/t/02_refs.t +++ b/dist/Thread-Queue/t/02_refs.t @@ -14,7 +14,7 @@ use threads::shared; 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; } diff --git a/dist/Thread-Queue/t/03_peek.t b/dist/Thread-Queue/t/03_peek.t index 29ef75e7fe..d543b59469 100644 --- a/dist/Thread-Queue/t/03_peek.t +++ b/dist/Thread-Queue/t/03_peek.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/05_extract.t b/dist/Thread-Queue/t/05_extract.t index d8cb417be9..de0e78bfd0 100644 --- a/dist/Thread-Queue/t/05_extract.t +++ b/dist/Thread-Queue/t/05_extract.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/06_insert.t b/dist/Thread-Queue/t/06_insert.t index 93617e13a3..4f9d1dff5e 100644 --- a/dist/Thread-Queue/t/06_insert.t +++ b/dist/Thread-Queue/t/06_insert.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/07_lock.t b/dist/Thread-Queue/t/07_lock.t index 633722103c..b20e0604ca 100644 --- a/dist/Thread-Queue/t/07_lock.t +++ b/dist/Thread-Queue/t/07_lock.t @@ -14,7 +14,7 @@ use Thread::Queue; 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; } diff --git a/dist/Thread-Queue/t/10_timed.t b/dist/Thread-Queue/t/10_timed.t index da8b03a7eb..8404720ed6 100644 --- a/dist/Thread-Queue/t/10_timed.t +++ b/dist/Thread-Queue/t/10_timed.t @@ -13,7 +13,7 @@ use threads; 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; } diff --git a/dist/Thread-Queue/t/11_limit.t b/dist/Thread-Queue/t/11_limit.t index 1bd88b39a1..12f351bc74 100644 --- a/dist/Thread-Queue/t/11_limit.t +++ b/dist/Thread-Queue/t/11_limit.t @@ -19,7 +19,7 @@ use Thread::Queue; use Test::More; -plan tests => 8; +plan tests => 13; 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 -my @item = $q->dequeue(3); -is_deeply(\@item, [4, 5, 'foo'], 'Dequeued 3 items'); +my @items = $q->dequeue(3); +is_deeply(\@items, [4, 5, 'foo'], 'Dequeued 3 items'); # Thread is now unblocked -@item = $q->dequeue(2); -is_deeply(\@item, [6, 7], 'Dequeued 2 items'); +@items = $q->dequeue(2); +is_deeply(\@items, [6, 7], 'Dequeued 2 items'); # Thread is now unblocked # Handshake with thread @@ -96,6 +96,37 @@ $rpt->enqueue('go'); # (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'); + +# (2) Thread will block trying to add to full queue +$th = threads->create( sub { + $q->enqueue(99); + return('OK'); +}); +threads->yield(); + +# (3) Dequeue an item so that thread can unblock +is($q->dequeue_nb(), 1, 'Dequeued item'); + +# (4) Thread unblocks +is($th->join(), 'OK', 'Thread exited'); + +# (5) Fetch queue to show thread's item was enqueued +@items = (); +while (my $item = $q->dequeue_nb()) { + push(@items, $item); +} +is_deeply(\@items, [2,3,99], 'Dequeued remaining'); + exit(0); # EOF -- 2.11.0 ```
p5pRT commented 7 years ago

From @jkeenan

On Wed\, 15 Feb 2017 04​:58​:53 GMT\, jdhedden@​gmail.com wrote​:

Third time's a charm. See attached.

Hope so! Smoking in this branch​:

smoke-me/jkeenan/130777-thread-queue

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 7 years ago

From @jkeenan

Branch got PASS on 6 smokers.

Pushed to blead in commit b4d001fde3d39646afbde8374bba5afff832e056

Thank you very much.

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 7 years ago

@jkeenan - Status changed from 'open' to 'resolved'