threads 1.51

From: "Jerry D. Hedden" <jdhedden@yahoo.com>
Message-ID: <71793.95536.qm@web30213.mail.mud.yahoo.com>

p4raw-id: //depot/perl@29293

6 files changed, 60 insertions, 54 deletions

diff --git a/ext/threads/Changes b/ext/threads/Changes
index f29126ff4c..a2b2d39d9e 100755
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension threads.
 
+1.51 Wed Nov 15 14:25:30 EST 2006
+	- Thread destruction fix
+
 1.49 Fri Nov  3 08:33:28 EST 2006
 	- Fix a warning message
 
diff --git a/ext/threads/README b/ext/threads/README
index effd009bfe..175170490d 100755
--- a/ext/threads/README
+++ b/ext/threads/README
@@ -1,4 +1,4 @@
-threads version 1.49
+threads version 1.51
 ====================
 
 This module exposes interpreter threads to the Perl level.
diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
index 8eb54c05ac..6c3043b937 100644
--- a/ext/threads/t/exit.t
+++ b/ext/threads/t/exit.t
@@ -56,7 +56,7 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 1.49;' .
+run_perl(prog => 'use threads 1.51;' .
                  'threads->exit(86);' .
                  'exit(99);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -104,7 +104,7 @@ $rc = $thr->join();
 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
 
 
-run_perl(prog => 'use threads 1.49 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.51 qw(exit thread_only);' .
                  'threads->create(sub { exit(99); })->join();' .
                  'exit(86);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -112,7 +112,7 @@ run_perl(prog => 'use threads 1.49 qw(exit thread_only);' .
 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 
 
-my $out = run_perl(prog => 'use threads 1.49;' .
+my $out = run_perl(prog => 'use threads 1.51;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '})->join();' .
@@ -124,7 +124,7 @@ is($?>>8, 99, "exit(status) in thread");
 like($out, '1 finished and unjoined', "exit(status) in thread");
 
 
-$out = run_perl(prog => 'use threads 1.49 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.51 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -137,7 +137,7 @@ is($?>>8, 99, "set_thread_exit_only(0)");
 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
 
 
-run_perl(prog => 'use threads 1.49;' .
+run_perl(prog => 'use threads 1.51;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .
diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index c4be8fe081..b3b716f44e 100644
--- a/ext/threads/t/thread.t
+++ b/ext/threads/t/thread.t
@@ -171,7 +171,7 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 1.49;' .
+run_perl(prog => 'use threads 1.51;' .
                  'sub a{threads->create(shift)} $t = a sub{};' .
                  '$t->tid; $t->join; $t->tid',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index 32d592f20d..303d0350f4 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.49';
+our $VERSION = '1.51';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -133,7 +133,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.49
+This document describes threads version 1.51
 
 =head1 SYNOPSIS
 
@@ -938,7 +938,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.49/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.51/threads.pm>
 
 L<threads::shared>, L<perlthrtut>
 
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 2002619321..3a1ea14e11 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -45,11 +45,12 @@ typedef perl_os_thread pthread_t;
 #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_THREAD_EXIT_ONLY      8
+#define PERL_ITHR_NONVIABLE             16
+#define PERL_ITHR_DESTROYED             32
 
 typedef struct _ithread {
     struct _ithread *next;      /* Next thread in the list */
@@ -133,8 +134,10 @@ S_ithread_clear(pTHX_ ithread *thread)
 {
     PerlInterpreter *interp;
 
-    assert((thread->state & PERL_ITHR_FINISHED) &&
-           (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)));
+    assert(((thread->state & PERL_ITHR_FINISHED) &&
+            (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))
+                ||
+           (thread->state & PERL_ITHR_NONVIABLE));
 
     interp = thread->interp;
     if (interp) {
@@ -159,28 +162,40 @@ S_ithread_clear(pTHX_ ithread *thread)
 STATIC void
 S_ithread_destruct(pTHX_ ithread *thread)
 {
-    dMY_POOL;
-
+    int destroy = 0;
 #ifdef WIN32
     HANDLE handle;
 #endif
-    /* Return if thread is still being used */
+    dMY_POOL;
+
+    /* Determine if thread can be destroyed now */
+    MUTEX_LOCK(&thread->mutex);
     if (thread->count != 0) {
-        return;
+        destroy = 0;
+    } else if (thread->state & PERL_ITHR_DESTROYED) {
+        destroy = 0;
+    } else if (thread->state & PERL_ITHR_NONVIABLE) {
+        thread->state |= PERL_ITHR_DESTROYED;
+        destroy = 1;
+    } else if (! (thread->state & PERL_ITHR_FINISHED)) {
+        destroy = 0;
+    } else if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
+        destroy = 0;
+    } else {
+        thread->state |= PERL_ITHR_DESTROYED;
+        destroy = 1;
     }
+    MUTEX_UNLOCK(&thread->mutex);
+    if (! destroy) return;
 
     /* Main thread (0) is immortal and should never get here */
     assert(thread->tid != 0);
 
     /* Remove from circular list of threads */
     MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
-    if ((! thread->next || ! thread->prev) && ckWARN_d(WARN_INTERNAL)) {
-        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Inconsistency in internal threads list found "
-                    "during destruction of thread %" UVuf, thread->tid);
-    }
-    if (thread->next) thread->next->prev = thread->prev;
-    if (thread->prev) thread->prev->next = thread->next;
+    assert(thread->prev && thread->next);
+    thread->next->prev = thread->prev;
+    thread->prev->next = thread->next;
     thread->next = NULL;
     thread->prev = NULL;
     MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
@@ -214,9 +229,8 @@ S_ithread_destruct(pTHX_ ithread *thread)
 STATIC int
 S_exit_warning(pTHX)
 {
-    dMY_POOL;
-
     int veto_cleanup;
+    dMY_POOL;
 
     MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
     veto_cleanup = (MY_POOL.running_threads || MY_POOL.joinable_threads);
@@ -261,17 +275,14 @@ int
 ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *)mg->mg_ptr;
-    int cleanup;
 
     MUTEX_LOCK(&thread->mutex);
-    cleanup = ((--thread->count == 0) &&
-               (thread->state & PERL_ITHR_FINISHED) &&
-               (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)));
+    thread->count--;
     MUTEX_UNLOCK(&thread->mutex);
 
-    if (cleanup) {
-        S_ithread_destruct(aTHX_ thread);
-    }
+    /* Try to clean up thread */
+    S_ithread_destruct(aTHX_ thread);
+
     return (0);
 }
 
@@ -372,7 +383,6 @@ S_ithread_run(void * arg)
     I32 oldscope;
     int exit_app = 0;
     int exit_code = 0;
-    int cleanup;
 
     dJMPENV;
 
@@ -465,17 +475,15 @@ S_ithread_run(void * arg)
     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 */
-    if (cleanup) {
+    if (thread->state & PERL_ITHR_DETACHED) {
         MY_POOL.detached_threads--;
     } else {
         MY_POOL.running_threads--;
         MY_POOL.joinable_threads++;
     }
+    MUTEX_UNLOCK(&thread->mutex);
     MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
 
     /* Exit application if required */
@@ -497,10 +505,8 @@ S_ithread_run(void * arg)
         my_exit(exit_code);
     }
 
-    /* Clean up detached thread */
-    if (cleanup) {
-        S_ithread_destruct(aTHX_ thread);
-    }
+    /* Try to clean up thread */
+    S_ithread_destruct(aTHX_ thread);
 
 #ifdef WIN32
     return ((DWORD)0);
@@ -562,8 +568,6 @@ S_ithread_create(
         int       exit_opt,
         SV       *params)
 {
-    dMY_POOL;
-
     ithread     *thread;
     CLONE_PARAMS clone_param;
     ithread     *current_thread = S_ithread_get(aTHX);
@@ -574,8 +578,9 @@ S_ithread_create(
     int          rc_stack_size = 0;
     int          rc_thread_create = 0;
 #endif
+    dMY_POOL;
 
-    /* Allocate thread structure in context of the main threads interpreter */
+    /* Allocate thread structure in context of the main thread's interpreter */
     {
         PERL_SET_CONTEXT(MY_POOL.main_thread.interp);
         thread = (ithread *)PerlMemShared_malloc(sizeof(ithread));
@@ -758,6 +763,7 @@ S_ithread_create(
         /* Must unlock mutex for destruct call */
         MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
         sv_2mortal(params);
+        thread->state |= PERL_ITHR_NONVIABLE;
         S_ithread_destruct(aTHX_ thread);
 #ifndef WIN32
         if (ckWARN_d(WARN_THREADS)) {
@@ -908,10 +914,10 @@ ithread_create(...)
             XSRETURN_UNDEF;     /* Mutex already unlocked */
         }
         ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));
+        MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
 
         /* Let thread run */
         MUTEX_UNLOCK(&thread->mutex);
-        MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
 
         /* XSRETURN(1); - implied */
 
@@ -1110,7 +1116,7 @@ ithread_detach(...)
     PREINIT:
         ithread *thread;
         int detach_err;
-        int cleanup;
+        int cleanup = 0;
         dMY_POOL;
     CODE:
         /* Check if the thread is detachable */
@@ -1132,21 +1138,18 @@ ithread_detach(...)
 #else
         PERL_THREAD_DETACH(thread->thr);
 #endif
-        /* Cleanup if finished */
-        cleanup = (thread->state & PERL_ITHR_FINISHED);
-        MUTEX_UNLOCK(&thread->mutex);
 
-        if (cleanup) {
+        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 (cleanup) {
-            S_ithread_destruct(aTHX_ thread);
-        }
+        /* Try to cleanup thread */
+        S_ithread_destruct(aTHX_ thread);
 
 
 void