From 033de87f380b64bf9f558f5d5c412d31230040c0 Mon Sep 17 00:00:00 2001 From: "Jerry D. Hedden" Date: Mon, 1 Oct 2012 09:12:58 -0400 Subject: [PATCH] Upgrade to threads::shared 1.42 --- MANIFEST | 1 + Porting/Maintainers.pl | 2 +- dist/threads-shared/lib/threads/shared.pm | 13 ++++- dist/threads-shared/shared.xs | 5 ++ dist/threads-shared/t/dualvar.t | 93 +++++++++++++++++++++++++++++++ 5 files changed, 110 insertions(+), 4 deletions(-) create mode 100644 dist/threads-shared/t/dualvar.t diff --git a/MANIFEST b/MANIFEST index 6ac316d..6fab70f 100644 --- 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 --- 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 --- 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 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 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) is unreliable for testing @@ -607,6 +607,13 @@ Either of the following will work instead: ... } +This module supports dual-valued variables created using L). 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 diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs index 58afefb..5da9a55 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 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); -- 2.7.4