our($VERSION, $ithreads, $othreads);
BEGIN {
- $VERSION = '2.00';
+ $VERSION = '2.01';
use Config;
$ithreads = $Config{useithreads};
$othreads = $Config{use5005threads};
In Perl 5.8 the ithreads model became available through the C<threads>
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<perl -V> and looking for
=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) {
}
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
With 5005threads you may also C<lock> a sub, using C<lock &sub>.
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<locked> attribute. The C<locked> 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<lock &sub>, on the other hand, will not allow I<any> other
thread access for the duration of the lock.
The C<Thread-E<gt>self> function returns a thread object that represents
the thread making the C<Thread-E<gt>self> call.
+=item Thread->list
+
+Returns a list of all non-joined, non-detached Thread objects.
+
=item cond_wait VARIABLE
The C<cond_wait> function takes a B<locked> variable as
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<equal> tests whether two thread objects represent the same thread and
returns true if they do.
=item done
The C<done> method returns true if the thread you're checking has
-finished, and false otherwise. (Not available with ithreads.)
+finished, and false otherwise.
=back
#
sub async (&) {
- return Thread->new($_[0]);
+ return Thread->new(shift);
}
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 };
}
}
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 {
--- /dev/null
+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
projects / p5sagit/p5-mst-13.2.git / commitdiff