--- /dev/null
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+}
+
+use ExtUtils::testlib;
+
+use threads;
+use threads::shared;
+
+BEGIN {
+ $| = 1;
+ print("1..13\n"); ### Number of tests that will be run ###
+};
+
+my $TEST = 1;
+share($TEST);
+
+ok(1, 'Loaded');
+
+sub ok {
+ my ($ok, $name) = @_;
+
+ lock($TEST);
+ my $id = $TEST++;
+
+ # 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);
+}
+
+
+### Start of Testing ###
+
+sub foo
+{
+ my $context = shift;
+ my $wantarray = wantarray();
+
+ if ($wantarray) {
+ ok($context eq 'array', 'Array context');
+ return ('array');
+ } elsif (defined($wantarray)) {
+ ok($context eq 'scalar', 'Scalar context');
+ return 'scalar';
+ } else {
+ ok($context eq 'void', 'Void context');
+ return;
+ }
+}
+
+my ($thr) = threads->create('foo', 'array');
+my ($res) = $thr->join();
+ok($res eq 'array', 'Implicit array context');
+
+$thr = threads->create('foo', 'scalar');
+$res = $thr->join();
+ok($res eq 'scalar', 'Implicit scalar context');
+
+threads->create('foo', 'void');
+($thr) = threads->list();
+$res = $thr->join();
+ok(! defined($res), 'Implicit void context');
+
+$thr = threads->create({'context' => 'array'}, 'foo', 'array');
+($res) = $thr->join();
+ok($res eq 'array', 'Explicit array context');
+
+($thr) = threads->create({'scalar' => 'scalar'}, 'foo', 'scalar');
+$res = $thr->join();
+ok($res eq 'scalar', 'Explicit scalar context');
+
+$thr = threads->create({'void' => 1}, 'foo', 'void');
+$res = $thr->join();
+ok(! defined($res), 'Explicit void context');
+
+# EOF
use strict;
use warnings;
-our $VERSION = '1.29';
+our $VERSION = '1.31';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 VERSION
-This document describes threads version 1.29
+This document describes threads version 1.31
=head1 SYNOPSIS
sub start_thread {
my @args = @_;
- print "Thread started: @args\n";
+ print('Thread started: ', join(' ', @args), "\n");
}
my $thread = threads->create('start_thread', 'argument');
$thread->join();
my $thread3 = async { foreach (@files) { ... } };
$thread3->join();
- # Invoke thread in list context so it can return a list
+ # Invoke thread in list context (implicit) so it can return a list
my ($thr) = threads->create(sub { return (qw/a b c/); });
+ # or specify list context explicitly
+ my $thr = threads->create({'context' => 'list'},
+ sub { return (qw/a b c/); });
my @results = $thr->join();
$thread->detach();
$stack_size = threads->get_stack_size();
$old_size = threads->set_stack_size(32*4096);
+ # Create a thread with a specific context and stack size
+ my $thr = threads->create({ 'context' => 'list',
+ 'stack_size' => 32*4096 },
+ \&foo);
+ my @results = $thr->join();
+
$thr->kill('SIGUSR1');
=head1 DESCRIPTION
# or
my $thr = threads->create(\&func, ...);
-The thread may be created in I<list> context, or I<scalar> context as follows:
-
- # Create thread in list context
- my ($thr) = threads->create(...);
-
- # Create thread in scalar context
- my $thr = threads->create(...);
-
-This has consequences for the C<-E<gt>join()> method describe below.
-
-Although a thread may be created in I<void> context, to do so you must
-I<chain> either the C<-E<gt>join()> or C<-E<gt>detach()> method to the
-C<-E<gt>create()> call:
-
- threads->create(...)->join();
-
The C<-E<gt>new()> method is an alias for C<-E<gt>create()>.
=item $thr->join()
the thread finishes, C<-E<gt>join()> will return the return value(s) of the
entry point function.
-The context (void, scalar or list) of the thread creation is also the
-context for C<-E<gt>join()>. This means that if you intend to return an array
-from a thread, you must use C<my ($thr) = threads->create(...)>, and that
-if you intend to return a scalar, you must use C<my $thr = ...>:
+The context (void, scalar or list) for the return value(s) for C<-E<gt>join()>
+is determined at the time of thread creation.
- # Create thread in list context
+ # Create thread in list context (implicit)
my ($thr1) = threads->create(sub {
my @results = qw(a b c);
return (@results);
- };
+ });
+ # or (explicit)
+ my $thr1 = threads->create({'context' => 'list'},
+ sub {
+ my @results = qw(a b c);
+ return (@results);
+ });
# Retrieve list results from thread
my @res1 = $thr1->join();
- # Create thread in scalar context
+ # Create thread in scalar context (implicit)
my $thr2 = threads->create(sub {
my $result = 42;
return ($result);
- };
+ });
# Retrieve scalar result from thread
my $res2 = $thr2->join();
+ # Create a thread in void context (explicit)
+ my $thr3 = threads->create({'void' => 1},
+ sub { print("Hello, world\n"); });
+ # Join the thread in void context (i.e., no return value)
+ $thr3->join();
+
+See L</"THREAD CONTEXT"> for more details.
+
If the program exits without all other threads having been either joined or
detached, then a warning will be issued. (A program exits either because one
of its threads explicitly calls L<exit()|perlfunc/"exit EXPR">, or in the case
=back
+=head1 THREAD CONTEXT
+
+As with subroutines, the type of value returned from a thread's entry point
+function may be determined by the thread's I<context>: list, scalar or void.
+The thread's context is determined at thread creation. This is necessary so
+that the context is available to the entry point function via
+L<wantarry()|perlfunc/"wantarray">. The thread may then specify a value of
+the appropriate type to be returned from C<-E<gt>join()>.
+
+=head2 Explicit context
+
+Because thread creation and thread joining may occur in different contexts, it
+may be desirable to state the context explicitly to the thread's entry point
+function. This may be done by calling C<-E<gt>create()> with a parameter hash
+as the first argument:
+
+ my $thr = threads->create({'context' => 'list'}, \&foo);
+ ...
+ my @results = $thr->join();
+
+In the above, the threads object is returned to the parent thread in scalar
+context, and the thread's entry point function C<foo> will be called in list
+context such that the parent thread can receive a list from the C<-E<gt>join()>
+call. Similarly, if you need the threads object, but your thread will not be
+returning a value (i.e., I<void> context), you would do the following:
+
+ my $thr = threads->create({'context' => 'void'}, \&foo);
+ ...
+ $thr->join();
+
+The context type may also be used as the I<key> in the parameter hash followed
+by a I<true> value:
+
+ threads->create({'scalar' => 1}, \&foo);
+ ...
+ my ($thr) = threads->list();
+ my $result = $thr->join();
+
+=head2 Implicit context
+
+If not explicitly stated, the thread's context is implied from the context
+of the C<-E<gt>create()> call:
+
+ # Create thread in list context
+ my ($thr) = threads->create(...);
+
+ # Create thread in scalar context
+ my $thr = threads->create(...);
+
+ # Create thread in void context
+ threads->create(...);
+
=head1 THREAD STACK SIZE
The default per-thread stack size for different platforms varies
=item threads->create({'stack_size' => VALUE}, FUNCTION, ARGS)
-This change to the thread creation method permits specifying the stack size
-for an individual thread.
+The stack size an individual threads may also be specified. This may be done
+by calling C<-E<gt>create()> with a parameter hash as the first argument:
+
+ my $thr = threads->create({'stack_size' => 32*4096}, \&foo, @args);
=item $thr2 = $thr1->create(FUNCTION, ARGS)
=head1 THREAD SIGNALLING
-When safe signals is in effect (the default behavior - see L<Unsafe signals>
+When safe signals is in effect (the default behavior - see L</"Unsafe signals">
for more details), then signals may be sent and acted upon by individual
threads.
=item Cannot signal other threads without safe signals
Safe signals must be in effect to use the C<-E<gt>kill()> signalling method.
-See L<Unsafe signals> for more details.
+See L</"Unsafe signals"> for more details.
=item Unrecognized signal name: ...
L<http://www.cpanforum.com/dist/threads>
Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.29/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.31/shared.pm>
L<threads::shared>, L<perlthrtut>
char *classname,
SV *init_function,
IV stack_size,
+ int gimme,
SV *params)
{
ithread *thread;
MUTEX_INIT(&thread->mutex);
thread->tid = tid_counter++;
thread->stack_size = good_stack_size(aTHX_ stack_size);
- thread->gimme = GIMME_V;
+ thread->gimme = gimme;
/* "Clone" our interpreter into the thread's interpreter.
* This gives thread access to "static data" and code.
AV *params;
HV *specs;
IV stack_size;
+ int context;
+ char *str;
+ char ch;
int idx;
int ii;
CODE:
function_to_call = ST(idx+1);
+ context = -1;
if (specs) {
/* stack_size */
if (hv_exists(specs, "stack", 5)) {
} else if (hv_exists(specs, "stack_size", 10)) {
stack_size = SvIV(*hv_fetch(specs, "stack_size", 10, 0));
}
+
+ /* context */
+ if (hv_exists(specs, "context", 7)) {
+ str = (char *)SvPV_nolen(*hv_fetch(specs, "context", 7, 0));
+ switch (*str) {
+ case 'a':
+ case 'A':
+ context = G_ARRAY;
+ break;
+ case 's':
+ case 'S':
+ context = G_SCALAR;
+ break;
+ case 'v':
+ case 'V':
+ context = G_VOID;
+ break;
+ default:
+ Perl_croak(aTHX_ "Invalid context: %s", str);
+ }
+ } else if (hv_exists(specs, "array", 5)) {
+ if (SvTRUE(*hv_fetch(specs, "array", 5, 0))) {
+ context = G_ARRAY;
+ }
+ } else if (hv_exists(specs, "scalar", 6)) {
+ if (SvTRUE(*hv_fetch(specs, "scalar", 6, 0))) {
+ context = G_SCALAR;
+ }
+ } else if (hv_exists(specs, "void", 4)) {
+ if (SvTRUE(*hv_fetch(specs, "void", 4, 0))) {
+ context = G_VOID;
+ }
+ }
+ }
+ if (context == -1) {
+ context = GIMME_V; /* Implicit context */
+ } else {
+ context |= (GIMME_V & (~(G_ARRAY|G_SCALAR|G_VOID)));
}
/* Function args */
classname,
function_to_call,
stack_size,
+ context,
newRV_noinc((SV*)params)));
/* XSRETURN(1); - implied */
projects / p5sagit/p5-mst-13.2.git / commitdiff