threads::shared 1.19

From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510805071336y50db0a35t740fbe9a8192be64@mail.gmail.com>

p4raw-id: //depot/perl@33809

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index 54dbd57..092cefe 100644 (file)
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.18';
+our $VERSION = '1.19';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -73,7 +73,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.18
+This document describes threads::shared version 1.19
 
 =head1 SYNOPSIS
 
@@ -362,6 +362,23 @@ error message.  But the C<< $hashref->{key} >> is B<not> shared, causing the
 error "locking can only be used on shared values" to occur when you attempt to
 C<< lock($hasref->{key}) >>.
 
+Using L<refaddr()|Scalar::Util/"refaddr EXPR">) is unreliable for testing
+whether or not two shared references are equivalent (e.g., when testing for
+circular references).  Use L<is_shared()/"is_shared VARIABLE">, instead:
+
+    use threads;
+    use threads::shared;
+    use Scalar::Util qw(refaddr);
+
+    # If ref is shared, use threads::shared's internal ID.
+    # Otherwise, use refaddr().
+    my $addr1 = is_shared($ref1) || refaddr($ref1);
+    my $addr2 = is_shared($ref2) || refaddr($ref2);
+
+    if ($addr1 == $addr2) {
+        # The refs are equivalent
+    }
+
 View existing bug reports at, and submit any new bugs, problems, patches, etc.
 to: L<http://rt.cpan.org/Public/Dist/Display.html?Name=threads-shared>
 
@@ -371,7 +388,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.18/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.19/shared.pm>
 
 Source repository:
 L<http://code.google.com/p/threads-shared/>

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 7043f29..eca5ea8 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -712,6 +712,11 @@ sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg)
     ENTER_LOCK;
     if (SvROK(ssv)) {
         S_get_RV(aTHX_ sv, ssv);
+        // Look ahead for refs of refs
+        if (SvROK(SvRV(ssv))) {
+            SvROK_on(SvRV(sv));
+            S_get_RV(aTHX_ SvRV(sv), SvRV(ssv));
+        }
     } else {
         sv_setsv_nomg(sv, ssv);
     }
@@ -880,6 +885,11 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
         /* Exists in the array */
         if (SvROK(*svp)) {
             S_get_RV(aTHX_ sv, *svp);
+            // Look ahead for refs of refs
+            if (SvROK(SvRV(*svp))) {
+                SvROK_on(SvRV(sv));
+                S_get_RV(aTHX_ SvRV(sv), SvRV(*svp));
+            }
         } else {
             /* XXX Can this branch ever happen? DAPM */
             /* XXX assert("no such branch"); */

diff --git a/ext/threads/shared/t/stress.t b/ext/threads/shared/t/stress.t
index 584be33..607d25c 100644 (file)
--- a/ext/threads/shared/t/stress.t
+++ b/ext/threads/shared/t/stress.t
@@ -79,25 +79,34 @@ use threads::shared;
     # Gather thread results
     my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0);
     for (1..$cnt) {
-        my $rc = $threads[$_]->join();
-        if (! $rc) {
+        if (! $threads[$_]) {
             $failures++;
-        } elsif ($rc =~ /^timed out/) {
-            $timeouts++;
-        } elsif ($rc eq 'okay') {
-            $okay++;
         } else {
-            $unknown++;
-            print(STDERR "# Unknown error: $rc\n");
+            my $rc = $threads[$_]->join();
+            if (! $rc) {
+                $failures++;
+            } elsif ($rc =~ /^timed out/) {
+                $timeouts++;
+            } elsif ($rc eq 'okay') {
+                $okay++;
+            } else {
+                $unknown++;
+                print(STDERR "# Unknown error: $rc\n");
+            }
         }
     }
+    if ($failures) {
+        # Most likely due to running out of memory
+        print(STDERR "# Warning: $failures threads failed\n");
+        print(STDERR "# Note: errno 12 = ENOMEM\n");
+        $cnt -= $failures;
+    }
 
-    if ($failures || $unknown || (($okay + $timeouts) != $cnt)) {
+    if ($unknown || (($okay + $timeouts) != $cnt)) {
         print("not ok 1\n");
-        my $too_few = $cnt - ($okay + $failures + $timeouts + $unknown);
+        my $too_few = $cnt - ($okay + $timeouts + $unknown);
         print(STDERR "# Test failed:\n");
         print(STDERR "#\t$too_few too few threads reported\n") if $too_few;
-        print(STDERR "#\t$failures threads failed\n")          if $failures;
         print(STDERR "#\t$unknown unknown errors\n")           if $unknown;
         print(STDERR "#\t$timeouts threads timed out\n")       if $timeouts;
 

diff --git a/ext/threads/shared/t/sv_refs.t b/ext/threads/shared/t/sv_refs.t
index 2d47002..72dc3c4 100644 (file)
--- a/ext/threads/shared/t/sv_refs.t
+++ b/ext/threads/shared/t/sv_refs.t
@@ -31,7 +31,7 @@ sub ok {
 
 BEGIN {
     $| = 1;
-    print("1..11\n");   ### Number of tests that will be run ###
+    print("1..21\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -74,4 +74,30 @@ ok(10,$t1 eq 'bar',"Check that assign to a ROK works");
 
 ok(11, is_shared($foo), "Check for sharing");
 
+{
+    # Circular references with 3 shared scalars
+    my $x : shared;
+    my $y : shared;
+    my $z : shared;
+
+    $x = \$y;
+    $y = \$z;
+    $z = \$x;
+    ok(12, ref($x) eq 'REF', '$x ref type');
+    ok(13, ref($y) eq 'REF', '$y ref type');
+    ok(14, ref($z) eq 'REF', '$z ref type');
+
+    my @q :shared = ($x);
+    ok(15, ref($q[0]) eq 'REF', '$q[0] ref type');
+
+    my $w = $q[0];
+    ok(16, ref($w) eq 'REF', '$w ref type');
+    ok(17, ref($$w) eq 'REF', '$$w ref type');
+    ok(18, ref($$$w) eq 'REF', '$$$w ref type');
+    ok(19, ref($$$$w) eq 'REF', '$$$$w ref type');
+
+    ok(20, is_shared($x) == is_shared($w), '_id($x) == _id($w)');
+    ok(21, is_shared($w) == is_shared($$$$w), '_id($w) == _id($$$$w)');
+}
+
 # EOF