Upgrade to threads::shared 1.42

diff --git a/MANIFEST b/MANIFEST
index 6ac316d..6fab70f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3540,6 +3540,7 @@ dist/threads-shared/t/blessed.t           Test blessed shared variables
 dist/threads-shared/t/clone.t          Test shared cloning
 dist/threads-shared/t/cond.t           Test condition variables
 dist/threads-shared/t/disabled.t       Test threads::shared when threads are disabled.
+dist/threads-shared/t/dualvar.t        Test dual-valued variables
 dist/threads-shared/t/hv_refs.t                Test shared hashes containing references
 dist/threads-shared/t/hv_simple.t      Tests for basic shared hash functionality.
 dist/threads-shared/t/no_share.t       Tests for disabled share on variables.

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 6dbea2d..8a1e105 100755 (executable)
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1938,7 +1938,7 @@ use File::Glob qw(:case);
 
     'threads::shared' => {
         'MAINTAINER'   => 'jdhedden',
-        'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.41.tar.gz',
+        'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.42.tar.gz',
         'FILES'        => q[dist/threads-shared],
         'EXCLUDED'     => [
             qw( examples/class.pl

diff --git a/dist/threads-shared/lib/threads/shared.pm b/dist/threads-shared/lib/threads/shared.pm
index 66931a6..5bb811f 100644 (file)
--- a/dist/threads-shared/lib/threads/shared.pm
+++ b/dist/threads-shared/lib/threads/shared.pm
@@ -7,7 +7,7 @@ use warnings;
 
 use Scalar::Util qw(reftype refaddr blessed);
 
-our $VERSION = '1.41';
+our $VERSION = '1.42';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -195,7 +195,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.41
+This document describes threads::shared version 1.42
 
 =head1 SYNOPSIS
 
@@ -565,7 +565,7 @@ C<share()> allows you to C<< share($hashref->{key}) >> and
 C<< share($arrayref->[idx]) >> without giving any error message.  But the
 C<< $hashref->{key} >> or C<< $arrayref->[idx] >> is B<not> shared, causing
 the error "lock can only be used on shared values" to occur when you attempt
-to C<< lock($hasref->{key}) >> or C<< lock($arrayref->[idx]) >> in another
+to C<< lock($hashref->{key}) >> or C<< lock($arrayref->[idx]) >> in another
 thread.
 
 Using L<refaddr()|Scalar::Util/"refaddr EXPR">) is unreliable for testing
@@ -607,6 +607,13 @@ Either of the following will work instead:
         ...
     }
 
+This module supports dual-valued variables created using L<dualvar() from
+Scalar::Util|Scalar::Util/"dualvar NUM, STRING">).  However, while C<$!> acts
+like a dualvar, it is implemented as a tied SV.  To propagate its value, use
+the follow construct, if needed:
+
+    my $errno :shared = dualvar($!,$!);
+
 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>
 

diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index 58afefb..5da9a55 100644 (file)
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -937,6 +937,7 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
     dTHXc;
     SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
     SV **svp;
+    U32 dualvar_flags = SvFLAGS(sv) & (SVf_IOK|SVf_NOK);
     /* Theory - SV itself is magically shared - and we have ordered the
        magic such that by the time we get here it has been stored
        to its shared counterpart
@@ -965,6 +966,10 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
     CALLER_CONTEXT;
     Perl_sharedsv_associate(aTHX_ sv, *svp);
     sharedsv_scalar_store(aTHX_ sv, *svp);
+    /* Propagate dualvar flags */
+    if (SvPOK(*svp)) {
+        SvFLAGS(*svp) |= dualvar_flags;
+    }
     LEAVE_LOCK;
     return (0);
 }

diff --git a/dist/threads-shared/t/dualvar.t b/dist/threads-shared/t/dualvar.t
new file mode 100644 (file)
index 0000000..ef6fc17
--- /dev/null
+++ b/dist/threads-shared/t/dualvar.t
@@ -0,0 +1,93 @@
+use strict;
+use warnings;
+
+BEGIN {
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+}
+
+use ExtUtils::testlib;
+
+sub ok {
+    my ($id, $ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    if ($ok) {
+        print("ok $id - $name\n");
+    }
+    else {
+        print("not ok $id - $name\n");
+        printf("# Failed test at line %d\n", (caller)[2]);
+    }
+
+    return ($ok);
+}
+
+BEGIN {
+    $| = 1;
+    print("1..19\n");    ### Number of tests that will be run ###
+}
+
+use Scalar::Util qw(dualvar);
+
+use threads;
+use threads::shared;
+
+ok(1, 1, 'Loaded');
+
+### Start of Testing ###
+
+my $dv = dualvar(42, 'Fourty-Two');
+my $pi = dualvar(3.14, 'PI');
+
+my @a :shared;
+
+# Individual assignment
+# Verify that dualvar preserved during individual element assignment
+$a[0] = $dv;
+$a[1] = $pi;
+
+ok(2, $a[0] == 42, 'IV number preserved');
+ok(3, $a[0] eq 'Fourty-Two', 'string preserved');
+ok(4, $a[1] == 3.14, 'NV number preserved');
+ok(5, $a[1] eq 'PI', 'string preserved');
+
+#-- List initializer
+# Verify that dualvar preserved during initialization
+my @a2 :shared = ($dv, $pi);
+
+ok(6, $a2[0] == 42, 'IV number preserved');
+ok(7, $a2[0] eq 'Fourty-Two', 'string preserved');
+ok(8, $a2[1] == 3.14, 'NV number preserved');
+ok(9, $a2[1] eq 'PI', 'string preserved');
+
+#-- List assignment
+# Verify that dualvar preserved during list assignment
+my @a3 :shared = (0, 0);
+@a3 = ($dv, $pi);
+
+ok(10, $a3[0] == 42, 'IV number preserved');
+ok(11, $a3[0] eq 'Fourty-Two', 'string preserved');
+ok(12, $a3[1] == 3.14, 'NV number preserved');
+ok(13, $a3[1] eq 'PI', 'string preserved');
+
+# Back to non-shared
+# Verify that entries are still dualvar when leaving the array
+my @nsa = @a3;
+ok(14, $nsa[0] == 42, 'IV number preserved');
+ok(15, $nsa[0] eq 'Fourty-Two', 'string preserved');
+ok(16, $nsa[1] == 3.14, 'NV number preserved');
+ok(17, $nsa[1] eq 'PI', 'string preserved');
+
+# $! behaves like a dualvar, but is really implemented as a tied SV.
+# As a result sharing $! directly only propagates the string value.
+# However, we can create a dualvar from it.
+$! = 1;
+my $ss :shared = dualvar($!,$!);
+ok(18, $ss == 1, 'IV number preserved');
+ok(19, $ss eq $!, 'string preserved');
+
+exit(0);