Change 33809 by [EMAIL PROTECTED] on 2008/05/10 16:06:53
Subject: [PATCH - revised^2] threads::shared 1.19
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Wed, 7 May 2008 16:36:28 -0400
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/threads/shared/shared.pm#59 edit
... //depot/perl/ext/threads/shared/shared.xs#71 edit
... //depot/perl/ext/threads/shared/t/stress.t#6 edit
... //depot/perl/ext/threads/shared/t/sv_refs.t#7 edit
Differences ...
==== //depot/perl/ext/threads/shared/shared.pm#59 (text) ====
Index: perl/ext/threads/shared/shared.pm
--- perl/ext/threads/shared/shared.pm#58~33387~ 2008-02-27 08:05:12.000000000
-0800
+++ perl/ext/threads/shared/shared.pm 2008-05-10 09:06:53.000000000 -0700
@@ -5,7 +5,7 @@
use strict;
use warnings;
-our $VERSION = '1.18';
+our $VERSION = '1.19';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -73,7 +73,7 @@
=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 "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<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/>
==== //depot/perl/ext/threads/shared/shared.xs#71 (text) ====
Index: perl/ext/threads/shared/shared.xs
--- perl/ext/threads/shared/shared.xs#70~33360~ 2008-02-24 22:47:17.000000000
-0800
+++ perl/ext/threads/shared/shared.xs 2008-05-10 09:06:53.000000000 -0700
@@ -712,6 +712,11 @@
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 @@
/* 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"); */
==== //depot/perl/ext/threads/shared/t/stress.t#6 (text) ====
Index: perl/ext/threads/shared/t/stress.t
--- perl/ext/threads/shared/t/stress.t#5~33387~ 2008-02-27 08:05:12.000000000
-0800
+++ perl/ext/threads/shared/t/stress.t 2008-05-10 09:06:53.000000000 -0700
@@ -79,25 +79,34 @@
# 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;
==== //depot/perl/ext/threads/shared/t/sv_refs.t#7 (text) ====
Index: perl/ext/threads/shared/t/sv_refs.t
--- perl/ext/threads/shared/t/sv_refs.t#6~28923~ 2006-10-03
06:46:26.000000000 -0700
+++ perl/ext/threads/shared/t/sv_refs.t 2008-05-10 09:06:53.000000000 -0700
@@ -31,7 +31,7 @@
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(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
End of Patch.
