From: Jerry D. Hedden Date: Fri, 22 Feb 2008 17:10:35 +0000 (-0500) Subject: Thread::Queue 2.06 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7fb1c73b914e3f01e01da007d49287c1e329a33f;p=p5sagit%2Fp5-mst-13.2.git Thread::Queue 2.06 From: "Jerry D. Hedden" Message-ID: <1ff86f510802221410r2ceda3deg6cd503f0037b0805@mail.gmail.com> p4raw-id: //depot/perl@33362 --- diff --git a/MANIFEST b/MANIFEST index 2d10afb..469c9c1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2813,6 +2813,7 @@ lib/Thread/Queue/t/04_errs.t Thread::Queue tests lib/Thread/Queue/t/05_extract.t Thread::Queue tests lib/Thread/Queue/t/06_insert.t Thread::Queue tests lib/Thread/Queue/t/07_lock.t Thread::Queue tests +lib/Thread/Queue/t/08_nothreads.t Thread::Queue tests lib/Thread/Semaphore.pm Thread-safe semaphores lib/Thread/Semaphore/t/01_basic.t Thread::Semaphore tests lib/Thread/Semaphore/t/02_errs.t Thread::Semaphore tests diff --git a/lib/Thread/Queue.pm b/lib/Thread/Queue.pm index f436f04..0d9eb10 100644 --- a/lib/Thread/Queue.pm +++ b/lib/Thread/Queue.pm @@ -3,7 +3,7 @@ package Thread::Queue; use strict; use warnings; -our $VERSION = '2.03'; +our $VERSION = '2.06'; use threads::shared 0.96; use Scalar::Util 1.10 qw(looks_like_number); @@ -165,8 +165,10 @@ sub extract $make_shared = sub { my $item = shift; - # If already thread-shared, then just return the input item - return $item if (threads::shared::is_shared($item)); + # If not running 'threads' or already thread-shared, + # then just return the input item + return $item if (! $threads::threads || + threads::shared::is_shared($item)); # Make copies of array, hash and scalar refs my $copy; @@ -263,7 +265,7 @@ Thread::Queue - Thread-safe queues =head1 VERSION -This document describes Thread::Queue version 2.03 +This document describes Thread::Queue version 2.06 =head1 SYNOPSIS @@ -497,6 +499,11 @@ greater than zero): =back +=head1 NOTES + +Queues created by L can be used in both threaded and +non-threaded applications. + =head1 LIMITATIONS Passing objects on queues may not work if the objects' classes do not support @@ -511,7 +518,10 @@ Thread::Queue Discussion Forum on CPAN: L Annotated POD for Thread::Queue: -L +L + +Source repository: +L L, L diff --git a/lib/Thread/Queue/t/04_errs.t b/lib/Thread/Queue/t/04_errs.t index 1634b0f..00132d7 100644 --- a/lib/Thread/Queue/t/04_errs.t +++ b/lib/Thread/Queue/t/04_errs.t @@ -6,11 +6,6 @@ BEGIN { chdir('t'); unshift(@INC, '../lib'); } - use Config; - if (! $Config{'useithreads'}) { - print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); - exit(0); - } } use Thread::Queue; diff --git a/lib/Thread/Queue/t/08_nothreads.t b/lib/Thread/Queue/t/08_nothreads.t new file mode 100644 index 0000000..375d031 --- /dev/null +++ b/lib/Thread/Queue/t/08_nothreads.t @@ -0,0 +1,112 @@ +use strict; +use warnings; + +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir('t'); + unshift(@INC, '../lib'); + } +} + +use Test::More 'tests' => 32; + +use Thread::Queue; + +# Regular array +my @ary1 = qw/foo bar baz/; +push(@ary1, [ 1..3 ], { 'qux' => 99 }); + +# Shared array +my @ary2 :shared = (99, 21, 86); + +# Regular hash-based object +my $obj1 = { + 'foo' => 'bar', + 'qux' => 99, + 'biff' => [ qw/fee fi fo/ ], + 'boff' => { 'bork' => 'true' }, +}; +bless($obj1, 'Foo'); + +# Shared hash-based object +my $obj2 = &threads::shared::share({}); +$$obj2{'bar'} = 86; +$$obj2{'key'} = 'foo'; +bless($obj2, 'Bar'); + +# Scalar ref +my $sref1 = \do{ my $scalar = 'foo'; }; + +# Shared scalar ref object +my $sref2 = \do{ my $scalar = 69; }; +threads::shared::share($sref2); +bless($sref2, 'Baz'); + +# Ref of ref +my $foo = [ 5, 'bork', { 'now' => 123 } ]; +my $bar = \$foo; +my $baz = \$bar; +my $qux = \$baz; +is_deeply($$$$qux, $foo, 'Ref of ref'); + +# Queue up items +my $q = Thread::Queue->new(\@ary1, \@ary2); +ok($q, 'New queue'); +is($q->pending(), 2, 'Queue count'); +$q->enqueue($obj1, $obj2); +is($q->pending(), 4, 'Queue count'); +$q->enqueue($sref1, $sref2, $qux); +is($q->pending(), 7, 'Queue count'); + +# Process items in queue +{ + is($q->pending(), 7, 'Queue count in thread'); + + my $ref = $q->peek(3); + is(ref($ref), 'Bar', 'Item is object'); + + my $tary1 = $q->dequeue(); + ok($tary1, 'Thread got item'); + is(ref($tary1), 'ARRAY', 'Item is array ref'); + is_deeply($tary1, \@ary1, 'Complex array'); + + my $tary2 = $q->dequeue(); + ok($tary2, 'Thread got item'); + is(ref($tary2), 'ARRAY', 'Item is array ref'); + for (my $ii=0; $ii < @ary2; $ii++) { + is($$tary2[$ii], $ary2[$ii], 'Shared array element check'); + } + + my $tobj1 = $q->dequeue(); + ok($tobj1, 'Thread got item'); + is(ref($tobj1), 'Foo', 'Item is object'); + is_deeply($tobj1, $obj1, 'Object comparison'); + + my $tobj2 = $q->dequeue(); + ok($tobj2, 'Thread got item'); + is(ref($tobj2), 'Bar', 'Item is object'); + is($$tobj2{'bar'}, 86, 'Shared object element check'); + is($$tobj2{'key'}, 'foo', 'Shared object element check'); + + my $tsref1 = $q->dequeue(); + ok($tsref1, 'Thread got item'); + is(ref($tsref1), 'SCALAR', 'Item is scalar ref'); + is($$tsref1, 'foo', 'Scalar ref contents'); + + my $tsref2 = $q->dequeue(); + ok($tsref2, 'Thread got item'); + is(ref($tsref2), 'Baz', 'Item is object'); + is($$tsref2, 69, 'Shared scalar ref contents'); + + my $qux = $q->dequeue(); + is_deeply($$$$qux, $foo, 'Ref of ref'); + + is($q->pending(), 0, 'Empty queue'); + my $nothing = $q->dequeue_nb(); + ok(! defined($nothing), 'Nothing on queue'); +} + +# Check results of thread's activities +is($q->pending(), 0, 'Empty queue'); + +# EOF