Revision history for Perl extension threads.
+1.37 Thu Jul 20 13:33:33 EDT 2006
+ - Revert 'exit' behavior with override
+
1.36 Mon Jul 10 15:58:13 EDT 2006
- Ignore signals sent to terminated threads
-threads version 1.36
+threads version 1.37
====================
This module exposes interpreter threads to the Perl level.
print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
exit(0);
}
+
+ require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
}
use ExtUtils::testlib;
}
$| = 1;
- print("1..226\n"); ### Number of tests that will be run ###
+ print("1..18\n"); ### Number of tests that will be run ###
};
-my $TEST;
-BEGIN {
- share($TEST);
- $TEST = 1;
-}
-
ok(1, 'Loaded');
-sub ok {
- my ($ok, $name) = @_;
- if (! defined($name)) {
- # Bug in test
- $name = $ok;
- $ok = 0;
- }
- chomp($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]);
- print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
- }
-
- return ($ok);
-}
-
-
### Start of Testing ###
$SIG{'__WARN__'} = sub {
};
-sub nasty
-{
- my ($term, $warn, $die) = @_;
- my $tid = threads->tid();
-
- $SIG{'__WARN__'} = sub {
- my $msg = $_[0];
- ok($msg =~ /Thread \d+ terminated abnormally/, "WARN: $msg");
- if ($warn eq 'return') {
- return ('# __WARN__ returned');
- } elsif ($warn eq 'die') {
- die('# __WARN__ dying');
- } elsif ($warn eq 'exit') {
- CORE::exit(20);
- } else {
- threads->exit(21);
- }
- };
-
- $SIG{'__DIE__'} = sub {
- my $msg = $_[0];
- ok(1, "DIE: $msg");
- if ($die eq 'return') {
- return ('# __DIE__ returned');
- } elsif ($die eq 'die') {
- die('# __DIE__ dying');
- } elsif ($die eq 'exit') {
- CORE::exit(30);
- } else {
- threads->exit(31);
- }
- };
-
- ok(1, "Thread $tid");
- if ($term eq 'return') {
- return ('# Thread returned');
- } elsif ($term eq 'die') {
- die('# Thread dying');
- } elsif ($term eq 'exit') {
- CORE::exit(10);
- } else {
- threads->exit(11);
- }
-}
-
+my $thr = threads->create(sub {
+ threads->exit();
+ return (99); # Not seen
+});
+ok($thr, 'Created: threads->exit()');
+my $rc = $thr->join();
+ok(! defined($rc), 'Exited: threads->exit()');
-my @exit_types = qw(return die exit threads->exit);
-# Test (non-trivial) combinations of termination methods
-# WRT the thread and its handlers
-foreach my $die (@exit_types) {
- foreach my $wrn (@exit_types) {
- foreach my $thr (@exit_types) {
- # Things are well behaved if the thread just returns
- next if ($thr eq 'return');
+run_perl(prog => 'use threads 1.37;
+ threads->exit(86);
+ exit(99);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
+is($?>>8, 86, 'thread->exit(status) in main');
- # Skip combos with the die handler
- # if neither the thread nor the warn handler dies
- next if ($thr ne 'die' && $wrn ne 'die' && $die ne 'return');
- # Must send STDERR to file to filter out 'un-capturable' output
- my $rc;
- eval {
- local *STDERR;
- if (! open(STDERR, '>tmp.stderr')) {
- die('Failed to create "tmp.stderr"');
- }
+$thr = threads->create({'exit' => 'thread_only'}, sub {
+ exit(1);
+ return (99); # Not seen
+ });
+ok($thr, 'Created: thread_only');
+$rc = $thr->join();
+ok(! defined($rc), 'Exited: thread_only');
- $rc = threads->create('nasty', $thr, $wrn, $die)->join();
- close(STDERR);
- };
+$thr = threads->create(sub {
+ threads->set_thread_exit_only(1);
+ exit(1);
+ return (99); # Not seen
+});
+ok($thr, 'Created: threads->set_thread_exit_only');
+$rc = $thr->join();
+ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
- # Filter out 'un-capturable' output
- if (open(IN, 'tmp.stderr')) {
- while (my $line = <IN>) {
- if ($line !~ /^#/) {
- print(STDERR $line);
- }
- }
- close(IN);
- } else {
- ok(0, "Failed to open 'tmp.stderr': $!");
- }
- unlink('tmp.stderr');
- ok(! $@, ($@) ? "Thread problem: $@" : "Thread ran okay");
- ok(! defined($rc), "Thread returned 'undef'");
- }
+my $WAIT :shared = 1;
+$thr = threads->create(sub {
+ lock($WAIT);
+ while ($WAIT) {
+ cond_wait($WAIT);
}
-}
-
-
-# Again with:
-no warnings 'threads';
-
-sub less_nasty
+ exit(1);
+ return (99); # Not seen
+});
+threads->yield();
+ok($thr, 'Created: $thr->set_thread_exit_only');
+$thr->set_thread_exit_only(1);
{
- my ($term, $warn, $die) = @_;
- my $tid = threads->tid();
-
- $SIG{'__WARN__'} = sub {
- my $msg = $_[0];
- ok(0, "WARN: $msg");
- if ($warn eq 'return') {
- return ('# __WARN__ returned');
- } elsif ($warn eq 'die') {
- die('# __WARN__ dying');
- } elsif ($warn eq 'exit') {
- CORE::exit(20);
- } else {
- threads->exit(21);
- }
- };
-
- $SIG{'__DIE__'} = sub {
- my $msg = $_[0];
- ok(1, "DIE: $msg");
- if ($die eq 'return') {
- return ('# __DIE__ returned');
- } elsif ($die eq 'die') {
- die('# __DIE__ dying');
- } elsif ($die eq 'exit') {
- CORE::exit(30);
- } else {
- threads->exit(31);
- }
- };
-
- ok(1, "Thread $tid");
- if ($term eq 'return') {
- return ('# Thread returned');
- } elsif ($term eq 'die') {
- die('# Thread dying');
- } elsif ($term eq 'exit') {
- CORE::exit(10);
- } else {
- threads->exit(11);
- }
+ lock($WAIT);
+ $WAIT = 0;
+ cond_broadcast($WAIT);
}
-
-foreach my $die (@exit_types) {
- foreach my $wrn (@exit_types) {
- foreach my $thr (@exit_types) {
- # Things are well behaved if the thread just returns
- next if ($thr eq 'return');
-
- # Skip combos with the die handler
- # if neither the thread nor the warn handler dies
- next if ($thr ne 'die' && $wrn ne 'die' && $die ne 'return');
-
- my $rc;
- eval { $rc = threads->create('less_nasty', $thr, $wrn, $die)->join() };
- ok(! $@, ($@) ? "Thread problem: $@" : "Thread ran okay");
- ok(! defined($rc), "Thread returned 'undef'");
- }
- }
+$rc = $thr->join();
+ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
+
+
+run_perl(prog => 'use threads 1.37 qw(exit thread_only);
+ threads->create(sub { exit(99); })->join();
+ exit(86);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
+is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
+
+
+SKIP: {
+ skip('run_perl+STDERR broken under MSWin32', 4) if ($^O eq 'MSWin32');
+
+ my $out = run_perl(prog => 'use threads 1.37;
+ threads->create(sub {
+ exit(99);
+ })->join();
+ exit(86);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
+ stderr => 1);
+ is($?>>8, 99, "exit(status) in thread");
+ like($out, '1 finished and unjoined', "exit(status) in thread");
+
+
+ $out = run_perl(prog => 'use threads 1.37 qw(exit thread_only);
+ threads->create(sub {
+ threads->set_thread_exit_only(0);
+ exit(99);
+ })->join();
+ exit(86);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
+ stderr => 1);
+ is($?>>8, 99, "set_thread_exit_only(0)");
+ like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
}
-# Check termination warning concerning running threads
-$SIG{'__WARN__'} = sub {
- my $msg = shift;
- if ($^O eq 'VMS') {
- ok($msg =~ /0 running and unjoined/, '0 running and unjoined (VMS)');
- ok($msg =~ /3 finished and unjoined/, '3 finished and unjoined (VMS)');
- ok($msg =~ /0 running and detached/, '0 finished and detached (VMS)');
- } else {
- ok($msg =~ /1 running and unjoined/, '1 running and unjoined');
- ok($msg =~ /2 finished and unjoined/, '2 finished and unjoined');
- ok($msg =~ /3 running and detached/, '3 finished and detached');
- }
-};
-
-threads->create(sub { sleep(100); });
-threads->create(sub {});
-threads->create(sub {});
-threads->create(sub { sleep(100); })->detach();
-threads->create(sub { sleep(100); })->detach();
-threads->create(sub { sleep(100); })->detach();
-threads->yield();
-sleep(1);
+run_perl(prog => 'use threads 1.37;
+ threads->create(sub {
+ $SIG{__WARN__} = sub { exit(99); };
+ die();
+ })->join();
+ exit(86);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
+is($?>>8, 99, "exit(status) in thread warn handler");
+
+
+$thr = threads->create(sub {
+ $SIG{__WARN__} = sub { threads->exit(); };
+ local $SIG{__DIE__} = 'DEFAULT';
+ die('Died');
+});
+ok($thr, 'Created: threads->exit() in thread warn handler');
+$rc = $thr->join();
+ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');
# EOF
# bugid #24165
-run_perl(prog => 'use threads 1.36;
+run_perl(prog => 'use threads 1.37;
sub a{threads->create(shift)} $t = a sub{};
$t->tid; $t->join; $t->tid',
- nolib => ($ENV{PERL_CORE}) ? 0 : 1,
- switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
is($?, 0, 'coredump in global destruction');
# test CLONE_SKIP() functionality
use strict;
use warnings;
-our $VERSION = '1.36';
+our $VERSION = '1.37';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
# Handle args
while (my $sym = shift) {
- if ($sym =~ /^stack/) {
+ if ($sym =~ /^stack/i) {
threads->set_stack_size(shift);
+ } elsif ($sym =~ /^exit/i) {
+ my $flag = shift;
+ $threads::thread_exit_only = $flag =~ /^thread/i;
+
} elsif ($sym =~ /all/) {
push(@EXPORT, qw(yield));
### Methods, etc. ###
-# Our own exit function/method
+# Exit from a thread (only)
sub exit
{
- CORE::exit(0);
+ my ($class, $status) = @_;
+ if (! defined($status)) {
+ $status = 0;
+ }
+
+ # Class method only
+ if (ref($class)) {
+ require Carp;
+ Carp::croak("Usage: threads->exit(status)");
+ }
+
+ $class->set_thread_exit_only(1);
+ CORE::exit($status);
}
# 'Constant' args for threads->list()
=head1 VERSION
-This document describes threads version 1.36
+This document describes threads version 1.37
=head1 SYNOPSIS
- use threads ('yield', 'stack_size' => 64*4096);
+ use threads ('yield', 'stack_size' => 64*4096, 'exit' => 'threads_only');
sub start_thread {
my @args = @_;
$thread->detach();
+ # Get a thread's object
$thread = threads->self();
$thread = threads->object($tid);
+ # Get a thread's ID
$tid = threads->tid();
$tid = threads->self->tid();
$tid = $thread->tid();
+ # Give other threads a chance to run
threads->yield();
yield();
+ # Lists of non-detached threads
my @threads = threads->list();
my $thread_count = threads->list();
my @running = threads->list(threads::running);
my @joinable = threads->list(threads::joinable);
+ # Test thread objects
if ($thr1 == $thr2) {
...
}
+ # Manage thread stack size
$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 },
+ 'stack_size' => 32*4096,
+ 'exit' => 'thread_only' },
\&foo);
# Get thread's context
$thr->join();
}
+ # Send a signal to a thread
$thr->kill('SIGUSR1');
+ # Exit a thread
threads->exit();
=head1 DESCRIPTION
Class method that allows a thread to detach itself.
-=item threads->exit()
-
-The usual method for terminating a thread is to
-L<return()|perlfunc/"return EXPR"> from the entry point function with the
-appropriate return value(s).
-
-If needed, a thread can be exited at any time by calling
-C<threads-E<gt>exit()>. This will cause the thread to return C<undef> in a
-scalar context, or the empty list in a list context.
-
-Calling C<die()> in a thread indicates an abnormal exit for the thread. Any
-C<$SIG{__DIE__}> handler in the thread will be called first, and then the
-thread will exit with a warning message that will contain any arguments passed
-in the C<die()> call.
-
-Calling C<exit()> in a thread is discouraged, but is equivalent to calling
-C<threads-E<gt>exit()>.
-
-If the desired affect is to truly terminate the application from a thread,
-then use L<POSIX::_exit()|POSIX/"_exit">, if available.
-
=item threads->self()
Class method that allows a thread to obtain its own I<threads> object.
=back
+=head1 EXITING A THREAD
+
+The usual method for terminating a thread is to
+L<return()|perlfunc/"return EXPR"> from the entry point function with the
+appropriate return value(s).
+
+=over
+
+=item threads->exit()
+
+If needed, a thread can be exited at any time by calling
+C<threads-E<gt>exit()>. This will cause the thread to return C<undef> in a
+scalar context, or the empty list in a list context.
+
+When called from the I<main> thread, this behaves the same as C<exit(0)>.
+
+=item threads->exit(status)
+
+When called from a thread, this behaves like C<threads-E<gt>exit()> (i.e., the
+exit status code is ignored).
+
+When called from the I<main> thread, this behaves the same as C<exit(status)>.
+
+=item die()
+
+Calling C<die()> in a thread indicates an abnormal exit for the thread. Any
+C<$SIG{__DIE__}> handler in the thread will be called first, and then the
+thread will exit with a warning message that will contain any arguments passed
+in the C<die()> call.
+
+=item exit(status)
+
+Calling L<exit()|perlfunc/"exit EXPR"> inside a thread causes the whole
+application to terminate. Because of this, the use of C<exit()> inside
+threaded code, or in modules that might be used in threaded applications, is
+strongly discouraged.
+
+If C<exit()> really is needed, then consider using the following:
+
+ threads->exit() if $threads::threads; # Thread friendly
+ exit(status);
+
+=item use threads 'exit' => 'thread_only'
+
+This globally overrides the default behavior of calling C<exit()> inside a
+thread, and effectively causes such calls to behave the same as
+C<threads-E<gt>exit()>. In other words, with this setting, calling C<exit()>
+causes only the thread to terminate.
+
+Because of its global effect, this setting should not be used inside modules
+or the like.
+
+The I<main> thread is unaffected by this setting.
+
+=item threads->create({'exit' => 'thread_only'}, ...)
+
+This overrides the default behavior of C<exit()> inside the newly created
+thread only.
+
+=item $thr->set_thread_exit_only(boolean)
+
+This can be used to change the I<exit thread only> behavior for a thread after
+it has been created. With a I<true> argument, C<exit()> will cause the only
+the thread to exit. With a I<false> argument, C<exit()> will terminate the
+application.
+
+The I<main> thread is unaffected by this call.
+
+=item threads->set_thread_exit_only(boolean)
+
+Class method for use inside a thread to changes its own behavior for
+C<exit()>.
+
+The I<main> thread is unaffected by this call.
+
+=back
+
=head1 THREAD STATE
The following boolean methods are useful in determining the I<state> of a
an I/O call, sending it a signal will not cause the I/O call to be interrupted
such that the signal is acted up immediately.
+Sending a signal to a terminated thread is ignored.
+
=head1 WARNINGS
=over 4
If the program exits without all threads having either been joined or
detached, then this warning will be issued.
-NOTE: This warning cannot be suppressed using C<no warnings 'threads';> as
-suggested below.
+NOTE: If the I<main> thread exits, then this warning cannot be suppressed
+using C<no warnings 'threads';> as suggested below.
=item Thread creation failed: pthread_create returned #
L<http://www.cpanforum.com/dist/threads>
Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.36/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.37/threads.pm>
L<threads::shared>, L<perlthrtut>
#endif
/* Values for 'state' member */
-#define PERL_ITHR_JOINABLE 0
-#define PERL_ITHR_DETACHED 1
-#define PERL_ITHR_JOINED 2
-#define PERL_ITHR_FINISHED 4
+#define PERL_ITHR_JOINABLE 0
+#define PERL_ITHR_DETACHED 1
+#define PERL_ITHR_JOINED 2
+#define PERL_ITHR_FINISHED 4
+#define PERL_ITHR_THREAD_EXIT_ONLY 8
typedef struct _ithread {
struct _ithread *next; /* Next thread in the list */
}
-/* Called on exit */
+/* Warn if exiting with any unjoined threads */
int
-Perl_ithread_hook(pTHX)
+S_exit_warning(pTHX)
{
int veto_cleanup = 0;
+
MUTEX_LOCK(&create_destruct_mutex);
- if ((aTHX == PL_curinterp) &&
- (running_threads || joinable_threads))
- {
+ if (running_threads || joinable_threads) {
if (ckWARN_d(WARN_THREADS)) {
Perl_warn(aTHX_ "Perl exited with active threads:\n\t%"
IVdf " running and unjoined\n\t%"
veto_cleanup = 1;
}
MUTEX_UNLOCK(&create_destruct_mutex);
+
return (veto_cleanup);
}
+/* Called on exit from main thread */
+int
+Perl_ithread_hook(pTHX)
+{
+ return ((aTHX == PL_curinterp) ? S_exit_warning(aTHX) : 0);
+}
+
/* MAGIC (in mg.h sense) hooks */
#endif
{
ithread *thread = (ithread *)arg;
+ int jmp_rc = 0;
+ I32 oldscope;
+ int exit_app = 0;
+ int exit_code = 0;
int cleanup;
+ dJMPENV;
+
dTHXa(thread->interp);
PERL_SET_CONTEXT(thread->interp);
S_ithread_set(aTHX_ thread);
AV *params = (AV *)SvRV(thread->params);
int len = (int)av_len(params)+1;
int ii;
- int jmp_rc = 0;
- I32 oldscope;
-
- dJMPENV;
dSP;
ENTER;
/* Run the specified function */
len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL);
} else if (jmp_rc == 2) {
+ /* Thread exited */
+ exit_app = 1;
+ exit_code = STATUS_CURRENT;
while (PL_scopestack_ix > oldscope) {
LEAVE;
}
oldscope = PL_scopestack_ix;
JMPENV_PUSH(jmp_rc);
if (jmp_rc == 0) {
+ /* Warn that thread died */
Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV);
} else if (jmp_rc == 2) {
+ /* Warn handler exited */
+ exit_app = 1;
+ exit_code = STATUS_CURRENT;
while (PL_scopestack_ix > oldscope) {
LEAVE;
}
MUTEX_LOCK(&thread->mutex);
/* Mark as finished */
thread->state |= PERL_ITHR_FINISHED;
+ /* Clear exit flag if required */
+ if (thread->state & PERL_ITHR_THREAD_EXIT_ONLY)
+ exit_app = 0;
/* Cleanup if detached */
cleanup = (thread->state & PERL_ITHR_DETACHED);
MUTEX_UNLOCK(&thread->mutex);
+ /* Adjust thread status counts */
+ MUTEX_LOCK(&create_destruct_mutex);
if (cleanup) {
- MUTEX_LOCK(&create_destruct_mutex);
detached_threads--;
- MUTEX_UNLOCK(&create_destruct_mutex);
- S_ithread_destruct(aTHX_ thread);
} else {
- MUTEX_LOCK(&create_destruct_mutex);
running_threads--;
joinable_threads++;
- MUTEX_UNLOCK(&create_destruct_mutex);
}
+ MUTEX_UNLOCK(&create_destruct_mutex);
+
+ /* Exit application if required */
+ if (exit_app) {
+ oldscope = PL_scopestack_ix;
+ JMPENV_PUSH(jmp_rc);
+ if (jmp_rc == 0) {
+ /* Warn if there are unjoined threads */
+ S_exit_warning(aTHX);
+ } else if (jmp_rc == 2) {
+ /* Warn handler exited */
+ exit_code = STATUS_CURRENT;
+ while (PL_scopestack_ix > oldscope) {
+ LEAVE;
+ }
+ }
+ JMPENV_POP;
+
+ my_exit(exit_code);
+ }
+
+ /* Clean up detached thread */
+ if (cleanup)
+ S_ithread_destruct(aTHX_ thread);
#ifdef WIN32
return ((DWORD)0);
SV *init_function,
IV stack_size,
int gimme,
+ int exit_opt,
SV *params)
{
ithread *thread;
thread->tid = tid_counter++;
thread->stack_size = good_stack_size(aTHX_ stack_size);
thread->gimme = gimme;
+ thread->state = exit_opt;
/* "Clone" our interpreter into the thread's interpreter.
* This gives thread access to "static data" and code.
HV *specs;
IV stack_size;
int context;
+ int exit_opt;
+ SV *thread_exit_only;
char *str;
int idx;
int ii;
classname = HvNAME(SvSTASH(SvRV(ST(0))));
thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
stack_size = thread->stack_size;
+ exit_opt = thread->state & PERL_ITHR_THREAD_EXIT_ONLY;
} else {
/* threads->create() */
classname = (char *)SvPV_nolen(ST(0));
stack_size = default_stack_size;
+ thread_exit_only = get_sv("threads::thread_exit_only", TRUE);
+ exit_opt = (SvTRUE(thread_exit_only))
+ ? PERL_ITHR_THREAD_EXIT_ONLY : 0;
}
function_to_call = ST(idx+1);
context = G_VOID;
}
}
+
+ /* exit => thread_only */
+ if (hv_exists(specs, "exit", 4)) {
+ str = (char *)SvPV_nolen(*hv_fetch(specs, "exit", 4, 0));
+ exit_opt = (*str == 't' || *str == 'T')
+ ? PERL_ITHR_THREAD_EXIT_ONLY : 0;
+ }
}
if (context == -1) {
context = GIMME_V; /* Implicit context */
function_to_call,
stack_size,
context,
+ exit_opt,
newRV_noinc((SV*)params)));
/* XSRETURN(1); - implied */
MUTEX_UNLOCK(&thread->mutex);
/* XSRETURN(1); - implied */
+
+void
+ithread_set_thread_exit_only(...)
+ PREINIT:
+ ithread *thread;
+ CODE:
+ if (items != 2)
+ Perl_croak(aTHX_ "Usage: ->set_thread_exit_only(boolean)");
+ thread = SV_to_ithread(aTHX_ ST(0));
+ MUTEX_LOCK(&thread->mutex);
+ if (SvTRUE(ST(1))) {
+ thread->state |= PERL_ITHR_THREAD_EXIT_ONLY;
+ } else {
+ thread->state &= ~PERL_ITHR_THREAD_EXIT_ONLY;
+ }
+ MUTEX_UNLOCK(&thread->mutex);
+
#endif /* USE_ITHREADS */
projects / platform / upstream / perl.git / commitdiff