From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Tue, 15 Jul 2008 08:25:27 +0000 (+0000)
Subject: Upgrade to threads::shared 1.25 by Jerry D. Hedden
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a469502ffde47af0b05b575bdfc51039218392df;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to threads::shared 1.25 by Jerry D. Hedden
Fix for cloning read-only objects.

p4raw-id: //depot/perl@34141
---

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index f25f166..935e8f2 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -7,7 +7,7 @@ use warnings;
 
 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 @@ $make_shared = sub {
     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 @@ $make_shared = sub {
     }
 
     # 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 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =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<threads::shared> Discussion Forum on CPAN:
 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/>
diff --git a/ext/threads/shared/t/clone.t b/ext/threads/shared/t/clone.t
index 0e7e648..7969d53 100644
--- a/ext/threads/shared/t/clone.t
+++ b/ext/threads/shared/t/clone.t
@@ -31,7 +31,7 @@ sub ok {
 
 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 @@ ok($test++, 1, 'Loaded');
 ### Start of Testing ###
 
 {
-    # Scalar
     my $x = shared_clone(14);
     ok($test++, $x == 14, 'number');
 
@@ -119,6 +118,32 @@ ok($test++, 1, 'Loaded');
 }
 
 {
+    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++, 1, 'Loaded');
     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
diff --git a/ext/threads/shared/t/stress.t b/ext/threads/shared/t/stress.t
index b82d81e..9fe1c21 100644
--- a/ext/threads/shared/t/stress.t
+++ b/ext/threads/shared/t/stress.t
@@ -38,16 +38,17 @@ use threads::shared;
 {
     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 @@ use threads::shared;
         }
 
     } else {
-        print('ok 1');
-        print(' # TODO - not reliable under MSWin32') if ($^O eq 'MSWin32');
-        print("\n");
+        print("ok 1\n");
     }
 }