From: Jerry D. Hedden Date: Fri, 19 May 2006 13:42:50 +0000 (-0700) Subject: Explicit thread context X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9d9ff5b1fff4906f05921ce5a97efbe12eb12cf4;p=p5sagit%2Fp5-mst-13.2.git Explicit thread context From: "Jerry D. Hedden" Message-ID: <20060519134250.fb30e530d17747c2b054d625b8945d88.933b701674.wbe@email.secureserver.net> p4raw-id: //depot/perl@28290 --- diff --git a/MANIFEST b/MANIFEST index 91f1ced..2dd7461 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1147,6 +1147,7 @@ ext/threads/shared/t/wait.t Test cond_wait and cond_timedwait ext/threads/shared/typemap thread::shared types ext/threads/t/basic.t ithreads ext/threads/t/blocks.t Test threads in special blocks +ext/threads/t/context.t Explicit thread context ext/threads/t/end.t Test end functions ext/threads/t/free2.t More ithread destruction tests ext/threads/t/free.t Test ithread destruction diff --git a/ext/threads/Changes b/ext/threads/Changes index 0835079..157c094 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension threads. +1.31 Fri May 19 16:06:42 EDT 2006 + - Explicit thread context + 1.29 Thu May 18 16:09:28 EDT 2006 - Fix warning/core dump from ->create('foo') in BEGIN block diff --git a/ext/threads/README b/ext/threads/README index 6e33bdc..f04153d 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.29 +threads version 1.31 ==================== This module needs perl 5.8.0 or later compiled with 'useithreads'. diff --git a/ext/threads/t/context.t b/ext/threads/t/context.t new file mode 100644 index 0000000..8843bdf --- /dev/null +++ b/ext/threads/t/context.t @@ -0,0 +1,93 @@ +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 diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index 39416d3..b6211ba 100755 --- a/ext/threads/threads.pm +++ b/ext/threads/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '1.29'; +our $VERSION = '1.31'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -102,7 +102,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.29 +This document describes threads version 1.31 =head1 SYNOPSIS @@ -110,7 +110,7 @@ This document describes threads version 1.29 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(); @@ -120,8 +120,11 @@ This document describes threads version 1.29 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(); @@ -146,6 +149,12 @@ This document describes threads version 1.29 $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 @@ -187,22 +196,6 @@ a code ref. # or my $thr = threads->create(\&func, ...); -The thread may be created in I context, or I 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<-Ejoin()> method describe below. - -Although a thread may be created in I context, to do so you must -I either the C<-Ejoin()> or C<-Edetach()> method to the -C<-Ecreate()> call: - - threads->create(...)->join(); - The C<-Enew()> method is an alias for C<-Ecreate()>. =item $thr->join() @@ -211,27 +204,39 @@ This will wait for the corresponding thread to complete its execution. When the thread finishes, C<-Ejoin()> 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<-Ejoin()>. This means that if you intend to return an array -from a thread, you must use Ccreate(...)>, and that -if you intend to return a scalar, you must use C: +The context (void, scalar or list) for the return value(s) for C<-Ejoin()> +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 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, or in the case @@ -327,6 +332,58 @@ Class method that allows a thread to obtain its own I. =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: 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. The thread may then specify a value of +the appropriate type to be returned from C<-Ejoin()>. + +=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<-Ecreate()> 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 will be called in list +context such that the parent thread can receive a list from the C<-Ejoin()> +call. Similarly, if you need the threads object, but your thread will not be +returning a value (i.e., I 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 in the parameter hash followed +by a I 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<-Ecreate()> 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 @@ -394,8 +451,10 @@ threaded applications. =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<-Ecreate()> with a parameter hash as the first argument: + + my $thr = threads->create({'stack_size' => 32*4096}, \&foo, @args); =item $thr2 = $thr1->create(FUNCTION, ARGS) @@ -409,7 +468,7 @@ existing thread (C<$thr1>). This is shorthand for the following: =head1 THREAD SIGNALLING -When safe signals is in effect (the default behavior - see L +When safe signals is in effect (the default behavior - see L for more details), then signals may be sent and acted upon by individual threads. @@ -567,7 +626,7 @@ following results in the above error: =item Cannot signal other threads without safe signals Safe signals must be in effect to use the C<-Ekill()> signalling method. -See L for more details. +See L for more details. =item Unrecognized signal name: ... @@ -646,7 +705,7 @@ L Discussion Forum on CPAN: L Annotated POD for L: -L +L L, L diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 4d9ef4c..e85c6c7 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -451,6 +451,7 @@ S_ithread_create( char *classname, SV *init_function, IV stack_size, + int gimme, SV *params) { ithread *thread; @@ -489,7 +490,7 @@ S_ithread_create( 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. @@ -674,6 +675,9 @@ ithread_create(...) AV *params; HV *specs; IV stack_size; + int context; + char *str; + char ch; int idx; int ii; CODE: @@ -702,6 +706,7 @@ ithread_create(...) function_to_call = ST(idx+1); + context = -1; if (specs) { /* stack_size */ if (hv_exists(specs, "stack", 5)) { @@ -711,6 +716,44 @@ ithread_create(...) } 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 */ @@ -726,6 +769,7 @@ ithread_create(...) classname, function_to_call, stack_size, + context, newRV_noinc((SV*)params))); /* XSRETURN(1); - implied */