From: Jerry D. Hedden Date: Fri, 13 Apr 2007 12:51:40 +0000 (-0400) Subject: Fix Thread.pm X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9d40afd19ff47f5f5e62fab1f340c175ed9224e4;p=p5sagit%2Fp5-mst-13.2.git Fix Thread.pm From: "Jerry D. Hedden" Message-ID: <1ff86f510704130951t5f66baa0m4ed13018539976a3@mail.gmail.com> p4raw-id: //depot/perl@30953 --- diff --git a/MANIFEST b/MANIFEST index 99a666d..85b6514 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2774,6 +2774,7 @@ lib/Text/TabsWrap/t/tabs.t See if Text::Tabs works lib/Text/TabsWrap/t/wrap.t See if Text::Wrap::wrap works lib/Text/Wrap.pm Paragraph formatter lib/Thread.pm Thread extensions frontend +lib/Thread.t Thread extensions frontend tests lib/Thread/Queue.pm Threadsafe queue lib/Thread/Queue.t See if threadsafe queue works lib/Thread/Semaphore.pm Threadsafe semaphore diff --git a/lib/Thread.pm b/lib/Thread.pm index c9f05c0..d7508ab 100644 --- a/lib/Thread.pm +++ b/lib/Thread.pm @@ -5,7 +5,7 @@ use strict; our($VERSION, $ithreads, $othreads); BEGIN { - $VERSION = '2.00'; + $VERSION = '2.01'; use Config; $ithreads = $Config{useithreads}; $othreads = $Config{use5005threads}; @@ -49,6 +49,8 @@ and to implement fork() emulation on Win32 platforms. In Perl 5.8 the ithreads model became available through the C module. +In Perl 5.10, the 5005threads model will be removed from the Perl interpreter. + Neither model is configured by default into Perl (except, as mentioned above, in Win32 ithreads are always available.) You can see your Perl's threading configuration by running C and looking for @@ -77,12 +79,12 @@ use ithreads instead. =head1 SYNOPSIS - use Thread; + use Thread qw(:DEFAULT async yield); my $t = Thread->new(\&start_sub, @start_args); $result = $t->join; - $result = $t->eval; + $result = $t->eval; # not available with ithreads $t->detach; if ($t->done) { @@ -90,24 +92,22 @@ use ithreads instead. } if($t->equal($another_thread)) { - # ... + # ... } yield(); - my $tid = Thread->self->tid; + my $tid = Thread->self->tid; lock($scalar); lock(@array); lock(%hash); - lock(\&sub); # not available with ithreads - - $flags = $t->flags; # not available with ithreads + lock(\&sub); # not available with ithreads - my @list = Thread->list; # not available with ithreads + $flags = $t->flags; # not available with ithreads - use Thread 'async'; + my @list = Thread->list; =head1 DESCRIPTION @@ -151,8 +151,9 @@ block. With 5005threads you may also C a sub, using C. Any calls to that sub from another thread will block until the lock -is released. This behaviour is not equivalent to declaring the sub -with the C attribute. The C attribute serializes +is released. This behaviour is not equivalent to declaring the sub +with the C<:locked> attribute (5005threads only). The C<:locked> +attribute serializes access to a subroutine, but allows different threads non-simultaneous access. C, on the other hand, will not allow I other thread access for the duration of the lock. @@ -172,6 +173,10 @@ returns a thread object. The Cself> function returns a thread object that represents the thread making the Cself> call. +=item Thread->list + +Returns a list of all non-joined, non-detached Thread objects. + =item cond_wait VARIABLE The C function takes a B variable as @@ -236,7 +241,7 @@ that all traces of its existence can be removed once it stops running. Errors in detached threads will not be visible anywhere - if you want to catch them, you should use $SIG{__DIE__} or something like that. -=item equal +=item equal C tests whether two thread objects represent the same thread and returns true if they do. @@ -258,7 +263,7 @@ and the value may not be all that meaningful to you. =item done The C method returns true if the thread you're checking has -finished, and false otherwise. (Not available with ithreads.) +finished, and false otherwise. =back @@ -288,7 +293,7 @@ L (not available with ithreads) # sub async (&) { - return Thread->new($_[0]); + return Thread->new(shift); } sub eval { @@ -298,12 +303,12 @@ sub eval { sub unimplemented { print $_[0], " unimplemented with ", $Config{useithreads} ? "ithreads" : "5005threads", "\n"; - } sub unimplement { + no strict 'refs'; + no warnings 'redefine'; for my $m (@_) { - no strict 'refs'; *{"Thread::$m"} = sub { unimplemented $m }; } } @@ -314,18 +319,17 @@ BEGIN { require Carp; Carp::croak("This Perl has both ithreads and 5005threads (serious malconfiguration)"); } - XSLoader::load 'threads'; + no strict 'refs'; + require threads; for my $m (qw(new join detach yield self tid equal list)) { - no strict 'refs'; *{"Thread::$m"} = \&{"threads::$m"}; } - require 'threads/shared.pm'; + require threads::shared; for my $m (qw(cond_signal cond_broadcast cond_wait)) { - no strict 'refs'; - *{"Thread::$m"} = \&{"threads::shared::${m}_enabled"}; + *{"Thread::$m"} = \&{"threads::shared::$m"}; } - # trying to unimplement eval gives redefined warning - unimplement(qw(done flags)); + *Thread::done = sub { return ! shift->threads::is_running(); }; + unimplement(qw(eval flags)); } elsif ($othreads) { XSLoader::load 'Thread'; } else { diff --git a/lib/Thread.t b/lib/Thread.t new file mode 100644 index 0000000..2a0e2af --- /dev/null +++ b/lib/Thread.t @@ -0,0 +1,90 @@ +use strict; +use warnings; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + + use Config; + if (! $Config{usethreads}) { + print("1..0 # Skip: No threads\n"); + exit(0); + } +} + +use Thread qw(:DEFAULT async yield); + +use Test::More tests => 13; + +my $lock; +{ + no warnings 'once'; + if ($threads::shared::threads_shared) { + &threads::shared::share(\$lock); + } +} + + +BASIC: +{ + sub thr_sub + { + lock($lock); + my $self = Thread->self; + return $self->tid; + } + + my $thr; + { + lock($lock); + + $thr = Thread->new(\&thr_sub); + + isa_ok($thr, 'Thread'); + + ok(! $thr->done(), 'Thread running'); + is($thr->tid, 1, "thread's tid"); + + my ($thr2) = Thread->list; + ok($thr2->equal($thr), '->list returned thread'); + } + yield(); + sleep(1); + + ok($thr->done(), 'Thread done'); + is($thr->join(), 1, "->join returned thread's tid"); +} + +ASYNC: +{ + my $thr = async { Thread->self->tid; }; + isa_ok($thr, 'Thread'); + is($thr->tid, 2, "async thread's tid"); + is($thr->join, 2, "->join on async returned tid"); +} + +COND_: +{ + sub thr_wait + { + lock($lock); + cond_wait($lock); + return Thread->self->tid; + } + + my $thr = Thread->new(\&thr_wait); + isa_ok($thr, 'Thread'); + ok(! $thr->done(), 'Thread running'); + + { + lock($lock); + cond_signal($lock); + } + yield(); + sleep(1); + + ok($thr->done(), 'Thread done'); + is($thr->join(), 3, "->join returned thread's tid"); +} + +# EOF