Change 34141 by [EMAIL PROTECTED] on 2008/07/15 08:25:27
Upgrade to threads::shared 1.25 by Jerry D. Hedden
Fix for cloning read-only objects.
Affected files ...
... //depot/perl/ext/threads/shared/shared.pm#64 edit
... //depot/perl/ext/threads/shared/t/clone.t#3 edit
... //depot/perl/ext/threads/shared/t/stress.t#8 edit
Differences ...
==== //depot/perl/ext/threads/shared/shared.pm#64 (text) ====
Index: perl/ext/threads/shared/shared.pm
--- perl/ext/threads/shared/shared.pm#63~34098~ 2008-07-02 13:32:50.000000000
-0700
+++ perl/ext/threads/shared/shared.pm 2008-07-15 01:25:27.000000000 -0700
@@ -7,7 +7,7 @@
use Scalar::Util qw(reftype refaddr blessed);
-our $VERSION = '1.24';
+our $VERSION = '1.25';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -133,10 +133,6 @@
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;
}
@@ -169,8 +165,13 @@
}
# Clone READONLY flag
+ if ($ref_type eq 'SCALAR') {
+ if (Internals::SvREADONLY($$item)) {
+ Internals::SvREADONLY($$copy, 1) if ($] >= 5.008003);
+ }
+ }
if (Internals::SvREADONLY($item)) {
- Internals::SvREADONLY($copy, 1);
+ Internals::SvREADONLY($copy, 1) if ($] >= 5.008003);
}
return $copy;
@@ -186,7 +187,7 @@
=head1 VERSION
-This document describes threads::shared version 1.24
+This document describes threads::shared version 1.25
=head1 SYNOPSIS
@@ -540,7 +541,7 @@
L<http://www.cpanforum.com/dist/threads-shared>
Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.24/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.25/shared.pm>
Source repository:
L<http://code.google.com/p/threads-shared/>
==== //depot/perl/ext/threads/shared/t/clone.t#3 (text) ====
Index: perl/ext/threads/shared/t/clone.t
--- perl/ext/threads/shared/t/clone.t#2~34047~ 2008-06-13 10:06:18.000000000
-0700
+++ perl/ext/threads/shared/t/clone.t 2008-07-15 01:25:27.000000000 -0700
@@ -31,7 +31,7 @@
BEGIN {
$| = 1;
- print("1..28\n"); ### Number of tests that will be run ###
+ print("1..34\n"); ### Number of tests that will be run ###
};
my $test = 1;
@@ -43,7 +43,6 @@
### Start of Testing ###
{
- # Scalar
my $x = shared_clone(14);
ok($test++, $x == 14, 'number');
@@ -119,6 +118,32 @@
}
{
+ my $hsh :shared = shared_clone({'foo' => [qw/foo bar baz/]});
+ ok($test++, is_shared($hsh), 'Shared hash ref');
+ ok($test++, is_shared($hsh->{'foo'}), 'Shared hash ref elem');
+ ok($test++, $$hsh{'foo'}[1] eq 'bar', 'Cloned structure');
+}
+
+{
+ my $obj = \do { my $bork = 99; };
+ bless($obj, 'Bork');
+ Internals::SvREADONLY($$obj, 1) if ($] >= 5.008003);
+
+ my $bork = shared_clone($obj);
+ ok($test++, $$bork == 99, 'cloned scalar ref object');
+ ok($test++, Internals::SvREADONLY($$bork), 'read-only');
+ ok($test++, ref($bork) eq 'Bork', 'Object class');
+
+ threads->create(sub {
+ ok($test++, $$bork == 99, 'cloned scalar ref object in thread');
+ ok($test++, Internals::SvREADONLY($$bork), 'read-only');
+ ok($test++, ref($bork) eq 'Bork', 'Object class');
+ })->join();
+
+ $test += 3;
+}
+
+{
my $scalar = 'zip';
my $obj = {
@@ -149,13 +174,6 @@
ok($test++, ref($copy) eq 'Foo', 'Cloned object class');
}
-{
- my $hsh :shared = shared_clone({'foo' => [qw/foo bar baz/]});
- ok($test++, is_shared($hsh), 'Shared hash ref');
- ok($test++, is_shared($hsh->{'foo'}), 'Shared hash ref elem');
- ok($test++, $$hsh{'foo'}[1] eq 'bar', 'Cloned structure');
-}
-
exit(0);
# EOF
==== //depot/perl/ext/threads/shared/t/stress.t#8 (text) ====
Index: perl/ext/threads/shared/t/stress.t
--- perl/ext/threads/shared/t/stress.t#7~34047~ 2008-06-13 10:06:18.000000000
-0700
+++ perl/ext/threads/shared/t/stress.t 2008-07-15 01:25:27.000000000 -0700
@@ -38,16 +38,17 @@
{
my $cnt = 50;
- my $TIMEOUT = 30;
+ my $TIMEOUT = 60;
my $mutex = 1;
share($mutex);
my @threads;
- for (1..$cnt) {
+ for (reverse(1..$cnt)) {
$threads[$_] = threads->create(sub {
my $tnum = shift;
my $timeout = time() + $TIMEOUT;
+ threads->yield();
# Randomize the amount of work the thread does
my $sum;
@@ -123,9 +124,7 @@
}
} else {
- print('ok 1');
- print(' # TODO - not reliable under MSWin32') if ($^O eq 'MSWin32');
- print("\n");
+ print("ok 1\n");
}
}
End of Patch.
