From: Jerry D. Hedden Date: Wed, 14 May 2008 12:47:04 +0000 (-0400) Subject: Thread::Queue 2.08 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=09782346ff1f47d913bef106d29466f3d41825c8;p=p5sagit%2Fp5-mst-13.2.git Thread::Queue 2.08 From: "Jerry D. Hedden" Message-ID: <1ff86f510805140947h707fe273j5adec649b5cc4238@mail.gmail.com> p4raw-id: //depot/perl@33847 --- diff --git a/lib/Thread/Queue.pm b/lib/Thread/Queue.pm index dc2b1ed..abf33ae 100644 --- a/lib/Thread/Queue.pm +++ b/lib/Thread/Queue.pm @@ -3,19 +3,22 @@ package Thread::Queue; use strict; use warnings; -our $VERSION = '2.07'; +our $VERSION = '2.08'; -use threads::shared 0.96; +use threads::shared 1.21; use Scalar::Util 1.10 qw(looks_like_number blessed reftype refaddr); +# Carp errors from threads::shared calls should complain about caller +our @CARP_NOT = ("threads::shared"); + # Predeclarations for internal functions -my ($make_shared, $validate_count, $validate_index); +my ($validate_count, $validate_index); # Create a new queue possibly pre-populated with items sub new { my $class = shift; - my @queue :shared = map { $make_shared->($_, {}) } @_; + my @queue :shared = map { shared_clone($_) } @_; return bless(\@queue, $class); } @@ -24,7 +27,7 @@ sub enqueue { my $queue = shift; lock(@$queue); - push(@$queue, map { $make_shared->($_, {}) } @_) + push(@$queue, map { shared_clone($_) } @_) and cond_signal(@$queue); } @@ -111,7 +114,7 @@ sub insert } # Add new items to the queue - push(@$queue, map { $make_shared->($_, {}) } @_); + push(@$queue, map { shared_clone($_) } @_); # Add previous items back onto the queue push(@$queue, @tmp); @@ -161,98 +164,6 @@ sub extract ### Internal Functions ### -# Create a thread-shared version of a complex data structure or object -$make_shared = sub { - my ($item, $cloned) = @_; - - # 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; - if (my $ref_type = reftype($item)) { - # Check for previously cloned references - # (this takes care of circular refs as well) - my $addr = refaddr($item); - if (defined($addr) && exists($cloned->{$addr})) { - # Return the already existing clone - return $cloned->{$addr}; - } - - # Copy an array ref - if ($ref_type eq 'ARRAY') { - # Make empty shared array ref - $copy = &share([]); - # Add to clone checking hash - $cloned->{$addr} = $copy; - # Recursively copy and add contents - push(@$copy, map { $make_shared->($_, $cloned) } @$item); - } - - # Copy a hash ref - elsif ($ref_type eq 'HASH') { - # Make empty shared hash ref - $copy = &share({}); - # Add to clone checking hash - $cloned->{$addr} = $copy; - # Recursively copy and add contents - foreach my $key (keys(%{$item})) { - $copy->{$key} = $make_shared->($item->{$key}, $cloned); - } - } - - # Copy a scalar ref - elsif ($ref_type eq 'SCALAR') { - $copy = \do{ my $scalar = $$item; }; - share($copy); - # Clone READONLY flag - if (Internals::SvREADONLY($$item)) { - Internals::SvREADONLY($$copy, 1); - } - # Add to clone checking hash - $cloned->{$addr} = $copy; - } - - # Copy of a ref of a ref - elsif ($ref_type eq 'REF') { - # Special handling for $x = \$x - my $addr2 = refaddr($$item); - if ($addr2 == $addr) { - $copy = \$copy; - share($copy); - $cloned->{$addr} = $copy; - } else { - my $tmp; - $copy = \$tmp; - share($copy); - # Add to clone checking hash - $cloned->{$addr} = $copy; - # Recursively copy and add contents - $tmp = $make_shared->($$item, $cloned); - } - } - } - - # If no copy is created above, then just return the input item - # NOTE: This will end up generating an error for anything - # other than an ordinary scalar - return $item if (! defined($copy)); - - # If input item is an object, then bless the copy into the same class - if (my $class = blessed($item)) { - bless($copy, $class); - } - - # Clone READONLY flag - if (Internals::SvREADONLY($item)) { - Internals::SvREADONLY($copy, 1); - } - - return $copy; -}; - # Check value of the requested index $validate_index = sub { my $index = shift; @@ -291,7 +202,7 @@ Thread::Queue - Thread-safe queues =head1 VERSION -This document describes Thread::Queue version 2.07 +This document describes Thread::Queue version 2.08 =head1 SYNOPSIS @@ -544,7 +455,7 @@ Thread::Queue Discussion Forum on CPAN: L Annotated POD for Thread::Queue: -L +L Source repository: L diff --git a/lib/Thread/Queue/t/02_refs.t b/lib/Thread/Queue/t/02_refs.t index b09eca2..6ea63e8 100644 --- a/lib/Thread/Queue/t/02_refs.t +++ b/lib/Thread/Queue/t/02_refs.t @@ -23,7 +23,7 @@ if ($] == 5.008) { require Test::More; } Test::More->import(); -plan('tests' => 45); +plan('tests' => 46); # Regular array my @ary1 = qw/foo bar baz/; @@ -82,14 +82,14 @@ 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'); +$q->enqueue($sref1, $sref2, $foo, $qux); +is($q->pending(), 8, 'Queue count'); $q->enqueue($cir1, $cir1s, $cir2, $cir3); -is($q->pending(), 11, 'Queue count'); +is($q->pending(), 12, 'Queue count'); # Process items in thread threads->create(sub { - is($q->pending(), 11, 'Queue count in thread'); + is($q->pending(), 12, 'Queue count in thread'); my $tary1 = $q->dequeue(); ok($tary1, 'Thread got item'); @@ -132,6 +132,9 @@ threads->create(sub { is($$tsref2, 69, 'Shared scalar ref contents'); $$tsref2 = 'zzz'; + my $myfoo = $q->dequeue(); + is_deeply($myfoo, $foo, 'Array ref'); + my $qux = $q->dequeue(); is_deeply($$$$qux, $foo, 'Ref of ref');