threads 1.33

From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <20060703090153.fb30e530d17747c2b054d625b8945d88.b26e047e0f.wbe@email.secureserver.net>

p4raw-id: //depot/perl@28475

12 files changed, 459 insertions, 80 deletions

diff --git a/ext/threads/Changes b/ext/threads/Changes
index b4c9d5424a..c86f2434ba 100755
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,5 +1,14 @@
 Revision history for Perl extension threads.
 
+1.33 Mon Jul  3 10:11:20 EDT 2006
+	- 'exit' inside a thread silently terminates thread only
+	- Added 'threads->exit()' (just calls CORE::exit(0))
+	- Handle 'die/exit' in thread warn handlers if thread terminates
+	    with a warning
+	- Give exact accounting of unjoined threads on program termination
+	- Fix spurious 'failures' from t/blocks.t
+	- Set correct path to threads module in tests that use test.pl
+
 1.32 Mon Jun  5 09:27:53 EDT 2006
 	- Fix for HP-UX 10.20 pthread_attr_getstacksize usage
 	- Check for threads::shared in tests
diff --git a/ext/threads/README b/ext/threads/README
index 789411f1bb..d8706ac318 100755
--- a/ext/threads/README
+++ b/ext/threads/README
@@ -1,4 +1,4 @@
-threads version 1.32
+threads version 1.33
 ====================
 
 This module needs perl 5.8.0 or later compiled with 'useithreads'.
diff --git a/ext/threads/t/blocks.t b/ext/threads/t/blocks.t
index 1609a1896f..8c8a766cbd 100644
--- a/ext/threads/t/blocks.t
+++ b/ext/threads/t/blocks.t
@@ -31,8 +31,15 @@ BEGIN {
     print("1..5\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
+my ($TEST, $COUNT, $TOTAL);
+
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+    share($COUNT);
+    $COUNT = 0;
+    $TOTAL = 0;
+}
 
 ok(1, 'Loaded');
 
@@ -48,6 +55,7 @@ sub ok {
     } 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);
@@ -58,33 +66,45 @@ sub ok {
 
 $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
 
-sub foo { }
+sub foo { lock($COUNT); $COUNT++; }
 sub baz { 42 }
 
 my $bthr;
 BEGIN {
     $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
 
+    $TOTAL++;
     threads->create('foo')->join();
+    $TOTAL++;
     threads->create(\&foo)->join();
-    threads->create(sub {})->join();
+    $TOTAL++;
+    threads->create(sub { lock($COUNT); $COUNT++; })->join();
 
+    $TOTAL++;
     threads->create('foo')->detach();
+    $TOTAL++;
     threads->create(\&foo)->detach();
-    threads->create(sub {})->detach();
+    $TOTAL++;
+    threads->create(sub { lock($COUNT); $COUNT++; })->detach();
 
     $bthr = threads->create('baz');
 }
 
 my $mthr;
 MAIN: {
+    $TOTAL++;
     threads->create('foo')->join();
+    $TOTAL++;
     threads->create(\&foo)->join();
-    threads->create(sub {})->join();
+    $TOTAL++;
+    threads->create(sub { lock($COUNT); $COUNT++; })->join();
 
+    $TOTAL++;
     threads->create('foo')->detach();
+    $TOTAL++;
     threads->create(\&foo)->detach();
-    threads->create(sub {})->detach();
+    $TOTAL++;
+    threads->create(sub { lock($COUNT); $COUNT++; })->detach();
 
     $mthr = threads->create('baz');
 }
@@ -95,8 +115,12 @@ ok($bthr, 'BEGIN thread');
 ok($mthr->join() == 42, 'Main join');
 ok($bthr->join() == 42, 'BEGIN join');
 
-# make sure a still-running detached thread doesn't give a warning on exit
+# Wait for detached threads to finish
+{
+    threads->yield();
+    sleep(1);
+    lock($COUNT);
+    redo if ($COUNT < $TOTAL);
+}
 
-# *** add new tests above this one
-threads->create(sub { 1 while 1 })->detach();
-# *** add new tests above this one
+# EOF
diff --git a/ext/threads/t/context.t b/ext/threads/t/context.t
index fe9ea830a4..fda0233ebd 100644
--- a/ext/threads/t/context.t
+++ b/ext/threads/t/context.t
@@ -31,8 +31,11 @@ BEGIN {
     print("1..13\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
+my $TEST;
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+}
 
 ok(1, 'Loaded');
 
diff --git a/ext/threads/t/end.t b/ext/threads/t/end.t
index 70d4188677..b1955d997f 100644
--- a/ext/threads/t/end.t
+++ b/ext/threads/t/end.t
@@ -31,8 +31,11 @@ BEGIN {
     print("1..6\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
+my $TEST;
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+}
 
 ok(1, 'Loaded');
 
diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
new file mode 100644
index 0000000000..c0621c7078
--- /dev/null
+++ b/ext/threads/t/exit.t
@@ -0,0 +1,256 @@
+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;
+
+BEGIN {
+    eval {
+        require threads::shared;
+        import threads::shared;
+    };
+    if ($@ || ! $threads::shared::threads_shared) {
+        print("1..0 # Skip: threads::shared not available\n");
+        exit(0);
+    }
+
+    $| = 1;
+    print("1..226\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 {
+    my $msg = shift;
+    ok(0, "WARN in main: $msg");
+};
+$SIG{'__DIE__'} = sub {
+    my $msg = shift;
+    ok(0, "DIE in main: $msg");
+};
+
+
+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 @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');
+
+            # 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"');
+                }
+
+                $rc = threads->create('nasty', $thr, $wrn, $die)->join();
+
+                close(STDERR);
+            };
+
+            # 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'");
+        }
+    }
+}
+
+
+# Again with:
+no warnings 'threads';
+
+sub less_nasty
+{
+    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);
+    }
+}
+
+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'");
+        }
+    }
+}
+
+
+# Check termination warning concerning running threads
+$SIG{'__WARN__'} = sub {
+    my $msg = shift;
+    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);
+
+# EOF
diff --git a/ext/threads/t/free.t b/ext/threads/t/free.t
index 703ba3896f..0e8bd86cd1 100644
--- a/ext/threads/t/free.t
+++ b/ext/threads/t/free.t
@@ -31,8 +31,11 @@ BEGIN {
     print("1..29\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
+my $TEST;
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+}
 
 ok(1, 'Loaded');
 
diff --git a/ext/threads/t/free2.t b/ext/threads/t/free2.t
index da506521f4..eb33da1a68 100644
--- a/ext/threads/t/free2.t
+++ b/ext/threads/t/free2.t
@@ -36,8 +36,11 @@ BEGIN {
     print("1..74\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
+my $TEST;
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+}
 
 ok(1, 'Loaded');
 
diff --git a/ext/threads/t/join.t b/ext/threads/t/join.t
index 1f640442d5..bebfd6dcbf 100644
--- a/ext/threads/t/join.t
+++ b/ext/threads/t/join.t
@@ -31,8 +31,11 @@ BEGIN {
     print("1..17\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
+my $TEST;
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+}
 
 ok(1, 'Loaded');
 
diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index 0f037d6a5f..73b7e3a1fd 100644
--- a/ext/threads/t/thread.t
+++ b/ext/threads/t/thread.t
@@ -160,22 +160,22 @@ package main;
     ok($th->join());
 }
 {
-    # There is a slight chance (<< 1%) this test case will falsely fail
+    # There is a miniscule chance this test case may falsely fail
     # since it tests using rand()
     my %rand : shared;
     rand(10);
     threads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
     $_->join foreach threads->list;
-#    use Data::Dumper qw(Dumper);
-#    print Dumper(\%rand);
-    #$val = rand();
-    ok((keys %rand >= 24), "Check that rand() works after a new thread");
+    ok((keys %rand >= 23), "Check that rand() is randomized in new threads");
 }
 
 # bugid #24165
 
-run_perl(prog =>
-    'use threads; sub a{threads->create(shift)} $t = a sub{}; $t->tid; $t->join; $t->tid');
+run_perl(prog => 'use threads 1.33;
+                  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' ]);
 is($?, 0, 'coredump in global destruction');
 
 # test CLONE_SKIP() functionality
diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index 806af441e2..7e5cffbed1 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.32';
+our $VERSION = '1.33';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -74,6 +74,12 @@ sub import
 
 ### Methods, etc. ###
 
+# Our own exit function/method
+sub exit
+{
+    CORE::exit(0);
+}
+
 # 'new' is an alias for 'create'
 *new = \&create;
 
@@ -102,7 +108,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.32
+This document describes threads version 1.33
 
 =head1 SYNOPSIS
 
@@ -157,6 +163,8 @@ This document describes threads version 1.32
 
     $thr->kill('SIGUSR1');
 
+    threads->exit();
+
 =head1 DESCRIPTION
 
 Perl 5.6 introduced something called interpreter threads.  Interpreter threads
@@ -237,10 +245,8 @@ is determined at the time of thread creation.
 
 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
-of the main thread, reaches the end of the main program file.)
+If the program exits without all threads having either been joined or
+detached, then a warning will be issued.
 
 Calling C<-E<gt>join()> or C<-E<gt>detach()> on an already joined thread will
 cause an error to be thrown.
@@ -248,7 +254,11 @@ cause an error to be thrown.
 =item $thr->detach()
 
 Makes the thread unjoinable, and causes any eventual return value to be
-discarded.
+discarded.  When the program exits, any detached threads that are still
+running are silently terminated.
+
+If the program exits without all threads having either been joined or
+detached, then a warning will be issued.
 
 Calling C<-E<gt>join()> or C<-E<gt>detach()> on an already detached thread
 will cause an error to be thrown.
@@ -257,6 +267,27 @@ will cause an error to be thrown.
 
 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.
@@ -566,12 +597,13 @@ such that the signal is acted up immediately.
 
 =over 4
 
-=item A thread exited while # other threads were still running
+=item Perl exited with active threads:
 
-A thread (not necessarily the main thread) exited while there were still other
-threads running.  Usually, it's a good idea to first collect the return values
-of the created threads by joining them, and only then exit from the main
-thread.
+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.
 
 =item Thread creation failed: pthread_create returned #
 
@@ -581,7 +613,7 @@ cause for the failure.
 =item Thread # terminated abnormally: ...
 
 A thread terminated in some manner other than just returning from its entry
-point function.  For example, the thread may have exited via C<die>.
+point function.  For example, the thread may have terminated using C<die>.
 
 =item Using minimum thread stack size of #
 
@@ -623,7 +655,7 @@ following results in the above error:
 
     $thr->set_stack_size($size);
 
-=item Cannot signal other threads without safe signals
+=item Cannot signal 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.
@@ -705,7 +737,7 @@ L<threads> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads>
 
 Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.32/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.33/threads.pm>
 
 L<threads::shared>, L<perlthrtut>
 
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 3208fd1537..5e6d16cd87 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -2,6 +2,11 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+/* Workaround for XSUB.h bug under WIN32 */
+#ifdef WIN32
+#  undef setjmp
+#  define setjmp(x) _setjmp(x)
+#endif
 #ifdef HAS_PPPORT_H
 #  define NEED_PL_signals
 #  define NEED_newRV_noinc
@@ -81,8 +86,9 @@ static ithread *threads;
 static perl_mutex create_destruct_mutex;
 
 static UV tid_counter = 0;
-static IV active_threads = 0;
 static IV joinable_threads = 0;
+static IV running_threads = 0;
+static IV detached_threads = 0;
 #ifdef THREAD_CREATE_NEEDS_STACK
 static IV default_stack_size = THREAD_CREATE_NEEDS_STACK;
 #else
@@ -155,11 +161,11 @@ S_ithread_destruct(pTHX_ ithread *thread)
         return;
     }
 
-    MUTEX_LOCK(&create_destruct_mutex);
     /* Main thread (0) is immortal and should never get here */
     assert(thread->tid != 0);
 
     /* Remove from circular list of threads */
+    MUTEX_LOCK(&create_destruct_mutex);
     thread->next->prev = thread->prev;
     thread->prev->next = thread->next;
     thread->next = NULL;
@@ -195,9 +201,17 @@ Perl_ithread_hook(pTHX)
 {
     int veto_cleanup = 0;
     MUTEX_LOCK(&create_destruct_mutex);
-    if ((aTHX == PL_curinterp) && (joinable_threads != 1)) {
+    if ((aTHX == PL_curinterp) &&
+        (running_threads || joinable_threads))
+    {
         if (ckWARN_d(WARN_THREADS)) {
-            Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running", joinable_threads);
+            Perl_warn(aTHX_ "Perl exited with active threads:\n\t%"
+                            IVdf " running and unjoined\n\t%"
+                            IVdf " finished and unjoined\n\t%"
+                            IVdf " running and detached\n",
+                            running_threads,
+                            joinable_threads,
+                            detached_threads);
         }
         veto_cleanup = 1;
     }
@@ -266,7 +280,7 @@ good_stack_size(pTHX_ IV stack_size)
 #ifdef PTHREAD_STACK_MIN
     /* Can't use less than minimum */
     if (stack_size < PTHREAD_STACK_MIN) {
-        if (ckWARN_d(WARN_THREADS)) {
+        if (ckWARN(WARN_THREADS)) {
             Perl_warn(aTHX_ "Using minimum thread stack size of %" IVdf, (IV)PTHREAD_STACK_MIN);
         }
         return (PTHREAD_STACK_MIN);
@@ -346,6 +360,10 @@ S_ithread_run(void * arg)
         AV *params = (AV *)SvRV(thread->params);
         int len = (int)av_len(params)+1;
         int ii;
+        int jmp_rc = 0;
+        I32 oldscope;
+
+        dJMPENV;
 
         dSP;
         ENTER;
@@ -358,24 +376,44 @@ S_ithread_run(void * arg)
         }
         PUTBACK;
 
-        /* Run the specified function */
-        len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL);
+        oldscope = PL_scopestack_ix;
+        JMPENV_PUSH(jmp_rc);
+        if (jmp_rc == 0) {
+            /* Run the specified function */
+            len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL);
+        } else if (jmp_rc == 2) {
+            while (PL_scopestack_ix > oldscope) {
+                LEAVE;
+            }
+        }
+        JMPENV_POP;
 
         /* Remove args from stack and put back in params array */
         SPAGAIN;
         for (ii=len-1; ii >= 0; ii--) {
             SV *sv = POPs;
-            av_store(params, ii, SvREFCNT_inc(sv));
+            if (jmp_rc == 0) {
+                av_store(params, ii, SvREFCNT_inc(sv));
+            }
         }
 
+        FREETMPS;
+        LEAVE;
+
         /* Check for failure */
         if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
-            Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV);
+            oldscope = PL_scopestack_ix;
+            JMPENV_PUSH(jmp_rc);
+            if (jmp_rc == 0) {
+                Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV);
+            } else if (jmp_rc == 2) {
+                while (PL_scopestack_ix > oldscope) {
+                    LEAVE;
+                }
+            }
+            JMPENV_POP;
         }
 
-        FREETMPS;
-        LEAVE;
-
         /* Release function ref */
         SvREFCNT_dec(thread->init_function);
         thread->init_function = Nullsv;
@@ -390,15 +428,17 @@ S_ithread_run(void * arg)
     cleanup = (thread->state & PERL_ITHR_DETACHED);
     MUTEX_UNLOCK(&thread->mutex);
 
-    if (cleanup)
+    if (cleanup) {
+        MUTEX_LOCK(&create_destruct_mutex);
+        detached_threads--;
+        MUTEX_UNLOCK(&create_destruct_mutex);
         S_ithread_destruct(aTHX_ thread);
-
-    MUTEX_LOCK(&create_destruct_mutex);
-    active_threads--;
-    if (!cleanup) {
-	joinable_threads--;
+    } else {
+        MUTEX_LOCK(&create_destruct_mutex);
+        running_threads--;
+        joinable_threads++;
+        MUTEX_UNLOCK(&create_destruct_mutex);
     }
-    MUTEX_UNLOCK(&create_destruct_mutex);
 
 #ifdef WIN32
     return ((DWORD)0);
@@ -657,8 +697,7 @@ S_ithread_create(
         return (&PL_sv_undef);
     }
 
-    active_threads++;
-    joinable_threads++;
+    running_threads++;
     MUTEX_UNLOCK(&create_destruct_mutex);
 
     sv_2mortal(params);
@@ -685,7 +724,6 @@ ithread_create(...)
         IV stack_size;
         int context;
         char *str;
-        char ch;
         int idx;
         int ii;
     CODE:
@@ -920,6 +958,10 @@ ithread_join(...)
         S_ithread_clear(aTHX_ thread);
         MUTEX_UNLOCK(&thread->mutex);
 
+        MUTEX_LOCK(&create_destruct_mutex);
+        joinable_threads--;
+        MUTEX_UNLOCK(&create_destruct_mutex);
+
         /* If no return values, then just return */
         if (! params) {
             XSRETURN_UNDEF;
@@ -973,13 +1015,18 @@ ithread_detach(...)
         cleanup = (thread->state & PERL_ITHR_FINISHED);
         MUTEX_UNLOCK(&thread->mutex);
 
-        if (cleanup)
+        MUTEX_LOCK(&create_destruct_mutex);
+        if (cleanup) {
+            joinable_threads--;
+        } else {
+            running_threads--;
+            detached_threads++;
+        }
+        MUTEX_UNLOCK(&create_destruct_mutex);
+
+        if (cleanup) {
             S_ithread_destruct(aTHX_ thread);
-	else {
-	    MUTEX_LOCK(&create_destruct_mutex);
-	    joinable_threads--;
-	    MUTEX_UNLOCK(&create_destruct_mutex);
-	}
+        }
 
 
 void
@@ -991,15 +1038,12 @@ ithread_kill(...)
     CODE:
         /* Must have safe signals */
         if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
-            Perl_croak(aTHX_ "Cannot signal other threads without safe signals");
+            Perl_croak(aTHX_ "Cannot signal threads without safe signals");
 
         /* Object method only */
         if (! sv_isobject(ST(0)))
             Perl_croak(aTHX_ "Usage: $thr->kill('SIG...')");
 
-        /* Get thread */
-        thread = SV_to_ithread(aTHX_ ST(0));
-
         /* Get signal */
         sig_name = SvPV_nolen(ST(1));
         if (isALPHA(*sig_name)) {
@@ -1011,11 +1055,14 @@ ithread_kill(...)
             signal = SvIV(ST(1));
 
         /* Set the signal for the thread */
+        thread = SV_to_ithread(aTHX_ ST(0));
+        MUTEX_LOCK(&thread->mutex);
         {
             dTHXa(thread->interp);
             PL_psig_pend[signal]++;
             PL_sig_pending = 1;
         }
+        MUTEX_UNLOCK(&thread->mutex);
 
         /* Return the thread to allow for method chaining */
         ST(0) = ST(0);
@@ -1164,7 +1211,6 @@ BOOT:
     }
     Zero(thread, 1, ithread);
 
-    PL_perl_destruct_level = 2;
     MUTEX_INIT(&thread->mutex);
 
     thread->tid = tid_counter++;        /* Thread 0 */
@@ -1185,9 +1231,6 @@ BOOT:
     thread->thr = pthread_self();
 #  endif
 
-    active_threads++;
-    joinable_threads++;
-
     S_ithread_set(aTHX_ thread);
     MUTEX_UNLOCK(&create_destruct_mutex);
 #endif /* USE_ITHREADS */