From 2d2826733b14efb7509c9c0c28d27bca6f31d681 Mon Sep 17 00:00:00 2001 From: "Jerry D. Hedden" Date: Wed, 5 Sep 2012 13:23:00 -0400 Subject: [PATCH] Upgrade to threads::shared 1.41 --- Porting/Maintainers.pl | 2 +- dist/threads-shared/lib/threads/shared.pm | 34 +++++++++++++++++++++++++------ dist/threads-shared/t/clone.t | 25 ++++++++++++++++++++++- 3 files changed, 53 insertions(+), 8 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index a1a5d71..80141be 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1937,7 +1937,7 @@ use File::Glob qw(:case); 'threads::shared' => { 'MAINTAINER' => 'jdhedden', - 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.40.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.41.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 d4d62b2..66931a6 100644 --- a/dist/threads-shared/lib/threads/shared.pm +++ b/dist/threads-shared/lib/threads/shared.pm @@ -7,13 +7,16 @@ use warnings; use Scalar::Util qw(reftype refaddr blessed); -our $VERSION = '1.40'; +our $VERSION = '1.41'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; # Declare that we have been loaded $threads::shared::threads_shared = 1; +# Method of complaint about things we can't clone +$threads::shared::clone_warn = undef; + # Load the XS code, if applicable if ($threads::threads) { require XSLoader; @@ -156,7 +159,12 @@ $make_shared = sub { } else { require Carp; - Carp::croak("Unsupported ref type: ", $ref_type); + if (! defined($threads::shared::clone_warn)) { + Carp::croak("Unsupported ref type: ", $ref_type); + } elsif ($threads::shared::clone_warn) { + Carp::carp("Unsupported ref type: ", $ref_type); + } + return undef; } # If input item is an object, then bless the copy into the same class @@ -187,7 +195,7 @@ threads::shared - Perl extension for sharing data structures between threads =head1 VERSION -This document describes threads::shared version 1.40 +This document describes threads::shared version 1.41 =head1 SYNOPSIS @@ -311,6 +319,19 @@ For cloning empty array or hash refs, the following may also be used: $var = &share([]); # Same as $var = shared_clone([]); $var = &share({}); # Same as $var = shared_clone({}); +Not all Perl data types can be cloned (e.g., globs, code refs). By default, +C will L if it encounters such items. To change +this behaviour to a warning, then set the following: + + $threads::shared::clone_warn = 1; + +In this case, C will be substituted for the item to be cloned. If +set to zero: + + $threads::shared::clone_warn = 0; + +then the C substitution will be performed silently. + =item is_shared VARIABLE C checks if the specified variable is shared or not. If shared, @@ -383,10 +404,10 @@ L. The C function takes a B variable as a parameter, unlocks the variable, and blocks until another thread does a C or C for that same locked variable. The variable that -C blocked on is relocked after the C is satisfied. If +C blocked on is re-locked after the C is satisfied. If there are multiple threads Cing on the same variable, all but one will re-block waiting to reacquire the lock on the variable. (So if you're only -using C for synchronisation, give up the lock as soon as possible). +using C for synchronization, give up the lock as soon as possible). The two actions of unlocking the variable and entering the blocked wait state are atomic, the two actions of exiting from the blocked wait state and re-locking the variable are not. @@ -408,7 +429,8 @@ drops to zero: =item cond_timedwait CONDVAR, ABS_TIMEOUT, LOCKVAR In its two-argument form, C takes a B variable and an -absolute timeout as parameters, unlocks the variable, and blocks until the +absolute timeout in I seconds (see L +for more) as parameters, unlocks the variable, and blocks until the timeout is reached or another thread signals the variable. A false value is returned if the timeout is reached, and a true value otherwise. In either case, the variable is re-locked upon return. diff --git a/dist/threads-shared/t/clone.t b/dist/threads-shared/t/clone.t index fd31181..fcb3e71 100644 --- a/dist/threads-shared/t/clone.t +++ b/dist/threads-shared/t/clone.t @@ -27,7 +27,7 @@ sub ok { BEGIN { $| = 1; - print("1..34\n"); ### Number of tests that will be run ### + print("1..40\n"); ### Number of tests that will be run ### }; my $test = 1; @@ -170,6 +170,29 @@ ok($test++, 1, 'Loaded'); ok($test++, ref($copy) eq 'Foo', 'Cloned object class'); } +{ + my $foo = \*STDIN; + my $copy :shared; + eval { + $copy = shared_clone($foo); + }; + ok($test++, $@ =~ /Unsupported/, 'Cannot clone GLOB - fatal'); + ok($test++, ! defined($copy), 'Nothing cloned'); + + $threads::shared::clone_warn = 1; + my $warn; + $SIG{'__WARN__'} = sub { $warn = shift; }; + $copy = shared_clone($foo); + ok($test++, $warn =~ /Unsupported/, 'Cannot clone GLOB - warning'); + ok($test++, ! defined($copy), 'Nothing cloned'); + + $threads::shared::clone_warn = 0; + undef($warn); + $copy = shared_clone($foo); + ok($test++, ! defined($warn), 'Cannot clone GLOB - silent'); + ok($test++, ! defined($copy), 'Nothing cloned'); +} + exit(0); # EOF -- 2.7.4