Upgrade to threads::shared 1.42

3 files changed, 108 insertions, 3 deletions

diff --git a/dist/threads-shared/lib/threads/shared.pm b/dist/threads-shared/lib/threads/shared.pm
index 66931a64ea..5bb811f715 100644
--- 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 58afefb7f5..5da9a55938 100644
--- 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
index 0000000000..ef6fc177b5
--- /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);