Change 33883 by [EMAIL PROTECTED] on 2008/05/20 14:24:53
Integrate:
[ 33808]
Subject: [PATCH - revised] Thread::Queue 2.07
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Thu, 8 May 2008 10:05:51 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 33847]
Subject: [PATCH] Thread::Queue 2.08
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Wed, 14 May 2008 12:47:04 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 33871]
Subject: [PATCH] Thread::Semaphore 2.08
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Mon, 19 May 2008 13:06:20 -0400
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.10/perl/lib/Thread/Queue.pm#3 integrate
... //depot/maint-5.10/perl/lib/Thread/Queue/t/02_refs.t#2 integrate
... //depot/maint-5.10/perl/lib/Thread/Semaphore.pm#3 integrate
Differences ...
==== //depot/maint-5.10/perl/lib/Thread/Queue.pm#3 (text) ====
Index: perl/lib/Thread/Queue.pm
--- perl/lib/Thread/Queue.pm#2~33514~ 2008-03-13 11:31:54.000000000 -0700
+++ perl/lib/Thread/Queue.pm 2008-05-20 07:24:53.000000000 -0700
@@ -3,19 +3,22 @@
use strict;
use warnings;
-our $VERSION = '2.06';
+our $VERSION = '2.08';
-use threads::shared 0.96;
-use Scalar::Util 1.10 qw(looks_like_number);
+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([EMAIL PROTECTED], $class);
}
@@ -24,7 +27,7 @@
{
my $queue = shift;
lock(@$queue);
- push(@$queue, map { $make_shared->($_) } @_)
+ push(@$queue, map { shared_clone($_) } @_)
and cond_signal(@$queue);
}
@@ -111,7 +114,7 @@
}
# 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,72 +164,6 @@
### Internal Functions ###
-# Create a thread-shared version of a complex data structure or object
-$make_shared = sub {
- my $item = shift;
-
- # 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 = Scalar::Util::reftype($item)) {
- # Copy an array ref
- if ($ref_type eq 'ARRAY') {
- # Make empty shared array ref
- $copy = &share([]);
- # Recursively copy and add contents
- push(@$copy, map { $make_shared->($_) } @$item);
- }
-
- # Copy a hash ref
- elsif ($ref_type eq 'HASH') {
- # Make empty shared hash ref
- $copy = &share({});
- # Recursively copy and add contents
- foreach my $key (keys(%{$item})) {
- $copy->{$key} = $make_shared->($item->{$key});
- }
- }
-
- # 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);
- }
- }
-
- # Copy of a ref of a ref
- elsif ($ref_type eq 'REF') {
- my $tmp = $make_shared->($$item);
- $copy = \$tmp;
- share($copy);
- }
- }
-
- # 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));
-
- # Clone READONLY flag
- if (Internals::SvREADONLY($item)) {
- Internals::SvREADONLY($copy, 1);
- }
-
- # If input item is an object, then bless the copy into the same class
- if (my $class = Scalar::Util::blessed($item)) {
- bless($copy, $class);
- }
-
- return $copy;
-};
-
# Check value of the requested index
$validate_index = sub {
my $index = shift;
@@ -265,7 +202,7 @@
=head1 VERSION
-This document describes Thread::Queue version 2.06
+This document describes Thread::Queue version 2.08
=head1 SYNOPSIS
@@ -518,7 +455,7 @@
L<http://www.cpanforum.com/dist/Thread-Queue>
Annotated POD for Thread::Queue:
-L<http://annocpan.org/~JDHEDDEN/Thread-Queue-2.06/lib/Thread/Queue.pm>
+L<http://annocpan.org/~JDHEDDEN/Thread-Queue-2.08/lib/Thread/Queue.pm>
Source repository:
L<http://code.google.com/p/thread-queue/>
==== //depot/maint-5.10/perl/lib/Thread/Queue/t/02_refs.t#2 (text) ====
Index: perl/lib/Thread/Queue/t/02_refs.t
--- perl/lib/Thread/Queue/t/02_refs.t#1~33514~ 2008-03-13 11:31:54.000000000
-0700
+++ perl/lib/Thread/Queue/t/02_refs.t 2008-05-20 07:24:53.000000000 -0700
@@ -23,7 +23,7 @@
require Test::More;
}
Test::More->import();
-plan('tests' => 39);
+plan('tests' => 46);
# Regular array
my @ary1 = qw/foo bar baz/;
@@ -62,18 +62,34 @@
my $qux = \$baz;
is_deeply($$$$qux, $foo, 'Ref of ref');
+# Circular refs
+my $cir1;
+$cir1 = \$cir1;
+
+my $cir1s : shared;
+$cir1s = \$cir1s;
+
+my $cir2;
+$cir2 = [ \$cir2, { 'ref' => \$cir2 } ];
+
+my $cir3 :shared = &share({});
+$cir3->{'self'} = \$cir3;
+bless($cir3, 'Circular');
+
# Queue up items
my $q = Thread::Queue->new([EMAIL PROTECTED], [EMAIL PROTECTED]);
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(), 12, 'Queue count');
# Process items in thread
threads->create(sub {
- is($q->pending(), 7, 'Queue count in thread');
+ is($q->pending(), 12, 'Queue count in thread');
my $tary1 = $q->dequeue();
ok($tary1, 'Thread got item');
@@ -116,9 +132,38 @@
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');
+ my ($c1, $c1s, $c2, $c3) = $q->dequeue(4);
+ SKIP: {
+ skip("Needs threads::shared >= 1.19", 5)
+ if ($threads::shared::VERSION < 1.19);
+
+ is(threads::shared::_id($$c1),
+ threads::shared::_id($c1),
+ 'Circular ref - scalar');
+
+ is(threads::shared::_id($$c1s),
+ threads::shared::_id($c1s),
+ 'Circular ref - shared scalar');
+
+ is(threads::shared::_id(${$c2->[0]}),
+ threads::shared::_id($c2),
+ 'Circular ref - array');
+
+ is(threads::shared::_id(${$c2->[1]->{'ref'}}),
+ threads::shared::_id($c2),
+ 'Circular ref - mixed');
+
+ is(threads::shared::_id(${$c3->{'self'}}),
+ threads::shared::_id($c3),
+ 'Circular ref - hash');
+ }
+
is($q->pending(), 0, 'Empty queue');
my $nothing = $q->dequeue_nb();
ok(! defined($nothing), 'Nothing on queue');
==== //depot/maint-5.10/perl/lib/Thread/Semaphore.pm#3 (text) ====
Index: perl/lib/Thread/Semaphore.pm
--- perl/lib/Thread/Semaphore.pm#2~33513~ 2008-03-13 10:59:59.000000000
-0700
+++ perl/lib/Thread/Semaphore.pm 2008-05-20 07:24:53.000000000 -0700
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '2.07';
+our $VERSION = '2.08';
use threads::shared;
use Scalar::Util 1.10 qw(looks_like_number);
@@ -12,7 +12,10 @@
sub new {
my $class = shift;
my $val :shared = @_ ? shift : 1;
- if (! looks_like_number($val) || (int($val) != $val)) {
+ if (!defined($val) ||
+ ! looks_like_number($val) ||
+ (int($val) != $val))
+ {
require Carp;
$val = 'undef' if (! defined($val));
Carp::croak("Semaphore initializer is not an integer: $val");
@@ -25,7 +28,11 @@
my $sema = shift;
lock($$sema);
my $dec = @_ ? shift : 1;
- if (! looks_like_number($dec) || (int($dec) != $dec) || ($dec < 1)) {
+ if (! defined($dec) ||
+ ! looks_like_number($dec) ||
+ (int($dec) != $dec) ||
+ ($dec < 1))
+ {
require Carp;
$dec = 'undef' if (! defined($dec));
Carp::croak("Semaphore decrement is not a positive integer: $dec");
@@ -39,7 +46,11 @@
my $sema = shift;
lock($$sema);
my $inc = @_ ? shift : 1;
- if (! looks_like_number($inc) || (int($inc) != $inc) || ($inc < 1)) {
+ if (! defined($inc) ||
+ ! looks_like_number($inc) ||
+ (int($inc) != $inc) ||
+ ($inc < 1))
+ {
require Carp;
$inc = 'undef' if (! defined($inc));
Carp::croak("Semaphore increment is not a positive integer: $inc");
@@ -55,7 +66,7 @@
=head1 VERSION
-This document describes Thread::Semaphore version 2.07
+This document describes Thread::Semaphore version 2.08
=head1 SYNOPSIS
@@ -140,7 +151,7 @@
L<http://www.cpanforum.com/dist/Thread-Semaphore>
Annotated POD for Thread::Semaphore:
-L<http://annocpan.org/~JDHEDDEN/Thread-Semaphore-2.07/lib/Thread/Semaphore.pm>
+L<http://annocpan.org/~JDHEDDEN/Thread-Semaphore-2.08/lib/Thread/Semaphore.pm>
Source repository:
L<http://code.google.com/p/thread-semaphore/>
End of Patch.
