ok(! defined($rc), 'Exited: threads->exit()');
-run_perl(prog => 'use threads 1.56;' .
+run_perl(prog => 'use threads 1.57;' .
'threads->exit(86);' .
'exit(99);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
-run_perl(prog => 'use threads 1.56 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.57 qw(exit thread_only);' .
'threads->create(sub { exit(99); })->join();' .
'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
-my $out = run_perl(prog => 'use threads 1.56;' .
+my $out = run_perl(prog => 'use threads 1.57;' .
'threads->create(sub {' .
' exit(99);' .
- '})->join();' .
+ '});' .
+ 'sleep(1);' .
'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
like($out, '1 finished and unjoined', "exit(status) in thread");
-$out = run_perl(prog => 'use threads 1.56 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.57 qw(exit thread_only);' .
'threads->create(sub {' .
' threads->set_thread_exit_only(0);' .
' exit(99);' .
- '})->join();' .
+ '});' .
+ 'sleep(1);' .
'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
-run_perl(prog => 'use threads 1.56;' .
+run_perl(prog => 'use threads 1.57;' .
'threads->create(sub {' .
' $SIG{__WARN__} = sub { exit(99); };' .
' die();' .
}
$| = 1;
- print("1..53\n"); ### Number of tests that will be run ###
+ print("1..59\n"); ### Number of tests that will be run ###
};
my $TEST;
ok(! $thr->is_joinable(), 'thread not joinable');
ok(threads->list(threads::joinable) == 0, 'thread joinable list');
-threads->create(sub {
- ok(! threads->is_detached(), 'thread not detached');
- ok(threads->list(threads::running) == 1, 'thread running list');
- ok(threads->list(threads::joinable) == 0, 'thread joinable list');
- ok(threads->list(threads::all) == 1, 'thread list');
-})->join();
+{
+ my $go : shared = 0;
+ my $t = threads->create( sub {
+ ok(! threads->is_detached(), 'thread not detached');
+ ok(threads->list(threads::running) == 1, 'thread running list');
+ ok(threads->list(threads::joinable) == 0, 'thread joinable list');
+ ok(threads->list(threads::all) == 1, 'thread list');
+ lock($go); $go = 1; cond_signal($go);
+ });
+
+ { lock ($go); cond_wait($go) until $go; }
+ $t->join;
+}
+
+{
+ my $rdy :shared = 0;
+ sub thr_ready
+ {
+ lock($rdy);
+ $rdy++;
+ cond_signal($rdy);
+ }
+
+ my $go :shared = 0;
+ sub thr_wait
+ {
+ lock($go);
+ cond_wait($go) until $go;
+ }
+
+ my $done :shared = 0;
+ sub thr_done
+ {
+ lock($done);
+ $done++;
+ cond_signal($done);
+ }
+
+ my $thr_routine = sub { thr_ready(); thr_wait(); thr_done(); };
+
+ # Create 8 threads:
+ # 3 running, blocking on $go
+ # 2 running, blocking on $go, join pending
+ # 2 running, blocking on join of above
+ # 1 finished, unjoined
+
+ for (1..3) { threads->create($thr_routine); }
+
+ foreach my $t (map {threads->create($thr_routine)} 1..2) {
+ threads->create(sub { thr_ready(); $_[0]->join; thr_done(); }, $t);
+ }
+ threads->create(sub { thr_ready(); thr_done(); });
+ {
+ lock($done);
+ cond_wait($done) until ($done == 1);
+ }
+ {
+ lock($rdy);
+ cond_wait($rdy) until ($rdy == 8);
+ }
+ threads->yield();
+ sleep(1);
+
+ ok(threads->list(threads::running) == 5, 'thread running list');
+ ok(threads->list(threads::joinable) == 1, 'thread joinable list');
+ ok(threads->list(threads::all) == 6, 'thread all list');
+
+ { lock($go); $go = 1; cond_broadcast($go); }
+ {
+ lock($done);
+ cond_wait($done) until ($done == 8);
+ }
+ threads->yield();
+ sleep(1);
+
+ ok(threads->list(threads::running) == 0, 'thread running list');
+ # Two awaiting join() have completed
+ ok(threads->list(threads::joinable) == 6, 'thread joinable list');
+ ok(threads->list(threads::all) == 6, 'thread all list');
+
+ for (threads->list) { $_->join; }
+}
# EOF
/* Values for 'state' member */
#define PERL_ITHR_DETACHED 1
#define PERL_ITHR_JOINED 2
+#define PERL_ITHR_UNCALLABLE (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)
#define PERL_ITHR_FINISHED 4
#define PERL_ITHR_THREAD_EXIT_ONLY 8
#define PERL_ITHR_NONVIABLE 16
PerlInterpreter *interp;
assert(((thread->state & PERL_ITHR_FINISHED) &&
- (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))
+ (thread->state & PERL_ITHR_UNCALLABLE))
||
(thread->state & PERL_ITHR_NONVIABLE));
destroy = 1;
} else if (! (thread->state & PERL_ITHR_FINISHED)) {
destroy = 0;
- } else if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
+ } else if (! (thread->state & PERL_ITHR_UNCALLABLE)) {
destroy = 0;
} else {
thread->state |= PERL_ITHR_DESTROYED;
/* $thr->create() */
classname = HvNAME(SvSTASH(SvRV(ST(0))));
thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
+ MUTEX_LOCK(&thread->mutex);
stack_size = thread->stack_size;
exit_opt = thread->state & PERL_ITHR_THREAD_EXIT_ONLY;
+ MUTEX_UNLOCK(&thread->mutex);
} else {
/* threads->create() */
classname = (char *)SvPV_nolen(ST(0));
int list_context;
IV count = 0;
int want_running = 0;
+ int state;
dMY_POOL;
PPCODE:
/* Class method only */
thread != &MY_POOL.main_thread;
thread = thread->next)
{
+ MUTEX_LOCK(&thread->mutex);
+ state = thread->state;
+ MUTEX_UNLOCK(&thread->mutex);
+
/* Ignore detached or joined threads */
- if (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)) {
+ if (state & PERL_ITHR_UNCALLABLE) {
continue;
}
/* Filter per parameter */
if (items > 1) {
if (want_running) {
- if (thread->state & PERL_ITHR_FINISHED) {
+ if (state & PERL_ITHR_FINISHED) {
continue; /* Not running */
}
} else {
- if (! (thread->state & PERL_ITHR_FINISHED)) {
+ if (! (state & PERL_ITHR_FINISHED)) {
continue; /* Still running - not joinable yet */
}
}
ithread_join(...)
PREINIT:
ithread *thread;
+ ithread *current_thread;
int join_err;
AV *params;
int len;
#ifdef WIN32
DWORD waitcode;
#else
+ int rc_join;
void *retval;
#endif
dMY_POOL;
Perl_croak(aTHX_ "Usage: $thr->join()");
}
- /* Check if the thread is joinable */
+ /* Check if the thread is joinable and not ourselves */
thread = S_SV_to_ithread(aTHX_ ST(0));
- join_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED));
- if (join_err) {
- if (join_err & PERL_ITHR_DETACHED) {
- Perl_croak(aTHX_ "Cannot join a detached thread");
- } else {
- Perl_croak(aTHX_ "Thread already joined");
- }
+ current_thread = S_ithread_get(aTHX);
+
+ MUTEX_LOCK(&thread->mutex);
+ if ((join_err = (thread->state & PERL_ITHR_UNCALLABLE))) {
+ MUTEX_UNLOCK(&thread->mutex);
+ Perl_croak(aTHX_ (join_err & PERL_ITHR_DETACHED)
+ ? "Cannot join a detached thread"
+ : "Thread already joined");
+ } else if (thread->tid == current_thread->tid) {
+ MUTEX_UNLOCK(&thread->mutex);
+ Perl_croak(aTHX_ "Cannot join self");
}
+ /* Mark as joined */
+ thread->state |= PERL_ITHR_JOINED;
+ MUTEX_UNLOCK(&thread->mutex);
+
+ MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
+ MY_POOL.joinable_threads--;
+ MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
+
/* Join the thread */
#ifdef WIN32
- waitcode = WaitForSingleObject(thread->handle, INFINITE);
+ if (WaitForSingleObject(thread->handle, INFINITE) != WAIT_OBJECT_0) {
+ /* Timeout/abandonment unexpected here; check $^E */
+ Perl_croak(aTHX_ "PANIC: underlying join failed");
+ };
#else
- pthread_join(thread->thr, &retval);
+ if ((rc_join = pthread_join(thread->thr, &retval)) != 0) {
+ /* In progress/deadlock/unknown unexpected here; check $! */
+ errno = rc_join;
+ Perl_croak(aTHX_ "PANIC: underlying join failed");
+ };
#endif
MUTEX_LOCK(&thread->mutex);
- /* Mark as joined */
- thread->state |= PERL_ITHR_JOINED;
-
/* Get the return value from the call_sv */
/* Objects do not survive this process - FIXME */
{
AV *params_copy;
PerlInterpreter *other_perl;
CLONE_PARAMS clone_params;
- ithread *current_thread;
params_copy = (AV *)SvRV(thread->params);
other_perl = thread->interp;
clone_params.stashes = newAV();
clone_params.flags = CLONEf_JOIN_IN;
PL_ptr_table = ptr_table_new();
- current_thread = S_ithread_get(aTHX);
S_ithread_set(aTHX_ thread);
/* Ensure 'meaningful' addresses retain their meaning */
ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
}
MUTEX_UNLOCK(&thread->mutex);
- MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
- if (! (thread->state & PERL_ITHR_DETACHED)) {
- MY_POOL.joinable_threads--;
- }
- MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
-
/* Try to cleanup thread */
S_ithread_destruct(aTHX_ thread);
CODE:
PERL_UNUSED_VAR(items);
- /* Check if the thread is detachable */
- thread = S_SV_to_ithread(aTHX_ ST(0));
- if ((detach_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))) {
- if (detach_err & PERL_ITHR_DETACHED) {
- Perl_croak(aTHX_ "Thread already detached");
- } else {
- Perl_croak(aTHX_ "Cannot detach a joined thread");
- }
- }
-
/* Detach the thread */
+ thread = S_SV_to_ithread(aTHX_ ST(0));
MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
MUTEX_LOCK(&thread->mutex);
- thread->state |= PERL_ITHR_DETACHED;
+ if (! (detach_err = (thread->state & PERL_ITHR_UNCALLABLE))) {
+ /* Thread is detachable */
+ thread->state |= PERL_ITHR_DETACHED;
#ifdef WIN32
- /* Windows has no 'detach thread' function */
+ /* Windows has no 'detach thread' function */
#else
- PERL_THREAD_DETACH(thread->thr);
+ PERL_THREAD_DETACH(thread->thr);
#endif
- if (thread->state & PERL_ITHR_FINISHED) {
- MY_POOL.joinable_threads--;
- } else {
- MY_POOL.running_threads--;
- MY_POOL.detached_threads++;
+ if (thread->state & PERL_ITHR_FINISHED) {
+ MY_POOL.joinable_threads--;
+ } else {
+ MY_POOL.running_threads--;
+ MY_POOL.detached_threads++;
+ }
}
MUTEX_UNLOCK(&thread->mutex);
MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
+ if (detach_err) {
+ Perl_croak(aTHX_ (detach_err & PERL_ITHR_DETACHED)
+ ? "Thread already detached"
+ : "Cannot detach a joined thread");
+ }
+
/* If thread is finished and didn't die,
* then we can free its interpreter */
MUTEX_LOCK(&thread->mutex);
char *classname;
UV tid;
ithread *thread;
+ int state;
int have_obj = 0;
dMY_POOL;
CODE:
/* Look for TID */
if (thread->tid == tid) {
/* Ignore if detached or joined */
- if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
+ MUTEX_LOCK(&thread->mutex);
+ state = thread->state;
+ MUTEX_UNLOCK(&thread->mutex);
+ if (! (state & PERL_ITHR_UNCALLABLE)) {
/* Put object on stack */
ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
have_obj = 1;
}
thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
+ MUTEX_LOCK(&thread->mutex);
ST(0) = (thread->state & PERL_ITHR_FINISHED) ? &PL_sv_no : &PL_sv_yes;
+ MUTEX_UNLOCK(&thread->mutex);
/* XSRETURN(1); - implied */
CODE:
PERL_UNUSED_VAR(items);
thread = S_SV_to_ithread(aTHX_ ST(0));
+ MUTEX_LOCK(&thread->mutex);
ST(0) = (thread->state & PERL_ITHR_DETACHED) ? &PL_sv_yes : &PL_sv_no;
+ MUTEX_UNLOCK(&thread->mutex);
/* XSRETURN(1); - implied */
thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
MUTEX_LOCK(&thread->mutex);
ST(0) = ((thread->state & PERL_ITHR_FINISHED) &&
- ! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))
+ ! (thread->state & PERL_ITHR_UNCALLABLE))
? &PL_sv_yes : &PL_sv_no;
MUTEX_UNLOCK(&thread->mutex);
/* XSRETURN(1); - implied */
projects / p5sagit/p5-mst-13.2.git / commitdiff