Upgrade to threads 1.58:

* Ignore thread return value(s) in void context
* Check for missing args for 'use threads' options
* Check that stack size argument is numeric

p4raw-id: //depot/perl@29973

diff --git a/ext/threads/Changes b/ext/threads/Changes
index 637926f..6eec369 100755 (executable)
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,5 +1,11 @@
 Revision history for Perl extension threads.
 
+1.58 Wed Jan 24 13:15:34 EST 2007
+       - Fix race conditions on thread destruction (Dave Mitchell)
+       - Ignore thread return value(s) in void context
+       - Check for missing args for 'use threads' options
+       - Check that stack size argument is numeric
+
 1.57 Wed Dec 20 13:10:26 EST 2006
        - Fixes courtesy of Michael J. Pomraning
            Eliminates self joins.

diff --git a/ext/threads/README b/ext/threads/README
index 210d012..0194702 100755 (executable)
--- a/ext/threads/README
+++ b/ext/threads/README
@@ -1,4 +1,4 @@
-threads version 1.57
+threads version 1.58
 ====================
 
 This module exposes interpreter threads to the Perl level.

diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
index 49549a9..a85c411 100644 (file)
--- 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.57;' .
+run_perl(prog => 'use threads 1.58;' .
                  '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.57 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.58 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.57 qw(exit thread_only);' .
 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 
 
-my $out = run_perl(prog => 'use threads 1.57;' .
+my $out = run_perl(prog => 'use threads 1.58;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '});' .
@@ -125,7 +125,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.57 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.58 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -139,7 +139,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.57;' .
+run_perl(prog => 'use threads 1.58;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .

diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index 7e71900..6020807 100644 (file)
--- 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.57;' .
+run_perl(prog => 'use threads 1.58;' .
                  '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 69214b3..e487f3b 100755 (executable)
--- a/ext/threads/threads.pm
+++ b/ext/threads/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.57';
+our $VERSION = '1.58';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -47,17 +47,22 @@ sub import
 
     # Handle args
     while (my $sym = shift) {
-        if ($sym =~ /^stack/i) {
-            threads->set_stack_size(shift);
-
-        } elsif ($sym =~ /^exit/i) {
-            my $flag = shift;
-            $threads::thread_exit_only = $flag =~ /^thread/i;
+        if ($sym =~ /^(?:stack|exit)/i) {
+            if (defined(my $arg = shift)) {
+                if ($sym =~ /^stack/i) {
+                    threads->set_stack_size($arg);
+                } else {
+                    $threads::thread_exit_only = $arg =~ /^thread/i;
+                }
+            } else {
+                require Carp;
+                Carp::croak("threads: Missing argument for option: $sym");
+            }
 
         } elsif ($sym =~ /^str/i) {
             import overload ('""' => \&tid);
 
-        } elsif ($sym =~ /(?:all|yield)/) {
+        } elsif ($sym =~ /^(?:all|yield)$/) {
             push(@EXPORT, qw(yield));
 
         } else {
@@ -133,7 +138,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.57
+This document describes threads version 1.58
 
 =head1 SYNOPSIS
 
@@ -230,8 +235,11 @@ for emulating fork() on Windows.
 
 The I<threads> API is loosely based on the old Thread.pm API. It is very
 important to note that variables are not shared between threads, all variables
-are by default thread local.  To use shared variables one must use
-L<threads::shared>.
+are by default thread local.  To use shared variables one must also use
+L<threads::shared>:
+
+    use threads;
+    use threads::shared;
 
 It is also important to note that you must enable threads by doing C<use
 threads> as early as possible in the script itself, and that it is not
@@ -949,7 +957,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.57/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.58/threads.pm>
 
 L<threads::shared>, L<perlthrtut>
 

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 80671ee..eb96414 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -45,12 +45,12 @@ typedef perl_os_thread pthread_t;
 #endif
 
 /* Values for 'state' member */
-#define PERL_ITHR_DETACHED           1 /* thread has been detached */
-#define PERL_ITHR_JOINED             2 /* thread has been joined */
-#define PERL_ITHR_FINISHED           4 /* thread has finished execution */
+#define PERL_ITHR_DETACHED           1 /* Thread has been detached */
+#define PERL_ITHR_JOINED             2 /* Thread has been joined */
+#define PERL_ITHR_FINISHED           4 /* Thread has finished execution */
 #define PERL_ITHR_THREAD_EXIT_ONLY   8 /* exit() only exits current thread */
-#define PERL_ITHR_NONVIABLE         16 /* thread creation failed */
-#define PERL_ITHR_DIED              32 /* thread finished by dying */
+#define PERL_ITHR_NONVIABLE         16 /* Thread creation failed */
+#define PERL_ITHR_DIED              32 /* Thread finished by dying */
 
 #define PERL_ITHR_UNCALLABLE  (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)
 
@@ -61,7 +61,7 @@ typedef struct _ithread {
     PerlInterpreter *interp;    /* The threads interpreter */
     UV tid;                     /* Threads module's thread id */
     perl_mutex mutex;           /* Mutex for updating things in this struct */
-    int count;                  /* reference count. See S_ithread_create */
+    int count;                  /* Reference count. See S_ithread_create. */
     int state;                  /* Detached, joined, finished, etc. */
     int gimme;                  /* Context of create */
     SV *init_function;          /* Code to run */
@@ -133,7 +133,10 @@ S_ithread_get(pTHX)
 
 /* Free any data (such as the Perl interpreter) attached to an ithread
  * structure.  This is a bit like undef on SVs, where the SV isn't freed,
- * but the PVX is.  Must be called with thread->mutex already held.
+ * but the PVX is.  Must be called with thread->mutex already locked.  Also,
+ * must be called with MY_POOL.create_destruct_mutex unlocked as destruction
+ * of the interpreter can lead to recursive destruction calls that could
+ * lead to a deadlock on that mutex.
  */
 STATIC void
 S_ithread_clear(pTHX_ ithread *thread)
@@ -171,8 +174,8 @@ S_ithread_clear(pTHX_ ithread *thread)
 
 /* Decrement the refcount of an ithread, and if it reaches zero, free it.
  * Must be called with the mutex held.
- * On return, mutex is released (or destroyed) */
-
+ * On return, mutex is released (or destroyed).
+ */
 STATIC void
 S_ithread_free(pTHX_ ithread *thread)
 {
@@ -187,8 +190,8 @@ S_ithread_free(pTHX_ ithread *thread)
             MUTEX_UNLOCK(&thread->mutex);
             return;
         }
-        assert((thread->state & PERL_ITHR_FINISHED)
-            && (thread->state & PERL_ITHR_UNCALLABLE));
+        assert((thread->state & PERL_ITHR_FINISHED) &&
+               (thread->state & PERL_ITHR_UNCALLABLE));
     }
     MUTEX_UNLOCK(&thread->mutex);
 
@@ -225,9 +228,9 @@ S_ithread_free(pTHX_ ithread *thread)
 
     /* total_threads >= 1 is used to veto cleanup by the main thread,
      * should it happen to exit while other threads still exist.
-     * Decrement this as the very last thing in the thread's existence,
-     * otherwise MY_POOL and global state such as PL_op_mutex may get
-     * freed while we're still using it
+     * Decrement this as the very last thing in the thread's existence.
+     * Otherwise, MY_POOL and global state such as PL_op_mutex may get
+     * freed while we're still using it.
      */
     MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
     MY_POOL.total_threads--;
@@ -235,7 +238,6 @@ S_ithread_free(pTHX_ ithread *thread)
 }
 
 
-
 static void
 S_ithread_count_inc(pTHX_ ithread *thread)
 {
@@ -245,7 +247,6 @@ S_ithread_count_inc(pTHX_ ithread *thread)
 }
 
 
-
 /* Warn if exiting with any unjoined threads */
 STATIC int
 S_exit_warning(pTHX)
@@ -273,10 +274,10 @@ S_exit_warning(pTHX)
     return (veto_cleanup);
 }
 
-/* Called from perl_destruct() in each thread. If it's the main thread,
- * stop it from freeing everything if there are other threads still
- * running */
 
+/* Called from perl_destruct() in each thread.  If it's the main thread,
+ * stop it from freeing everything if there are other threads still running.
+ */
 int
 Perl_ithread_hook(pTHX)
 {
@@ -301,11 +302,10 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *)mg->mg_ptr;
     MUTEX_LOCK(&thread->mutex);
-    S_ithread_free(aTHX_ thread); /* releases MUTEX */
+    S_ithread_free(aTHX_ thread);   /* Releases MUTEX */
     return (0);
 }
 
-
 int
 ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 {
@@ -535,14 +535,14 @@ S_ithread_run(void * arg)
         my_exit(exit_code);
     }
 
-    /* at this point the interpreter may have been freed, so call
-     * free in the context of of the 'main' interpreter. That can't have
-     * been freed, due to the veto_cleanup mechanism */
-
+    /* At this point, the interpreter may have been freed, so call
+     * free in the the context of of the 'main' interpreter which
+     * can't have been freed due to the veto_cleanup mechanism.
+     */
     aTHX = MY_POOL.main_thread.interp;
 
     MUTEX_LOCK(&thread->mutex);
-    S_ithread_free(aTHX_ thread); /* releases MUTEX */
+    S_ithread_free(aTHX_ thread);   /* Releases MUTEX */
 
 #ifdef WIN32
     return ((DWORD)0);
@@ -631,13 +631,13 @@ S_ithread_create(
     thread->prev->next = thread;
     MY_POOL.total_threads++;
 
-    /* 1 ref to be held by the local var 'thread' in S_ithread_run()
+    /* 1 ref to be held by the local var 'thread' in S_ithread_run().
      * 1 ref to be held by the threads object that we assume we will
-     *       be embedded in upon our return
-     * 1 ref to be the responsibility of join/detach, so we don't get freed
-             until join/detach, even if no thread objects remain. This
-             allows the following to work:
-                { threads->new(sub{...}); } threads->object(1)->join;
+     *      be embedded in upon our return.
+     * 1 ref to be the responsibility of join/detach, so we don't get
+     *      freed until join/detach, even if no thread objects remain.
+     *      This allows the following to work:
+     *          { threads->new(sub{...}); } threads->object(1)->join;
      */
     thread->count = 3;
 
@@ -803,7 +803,7 @@ S_ithread_create(
         MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
         sv_2mortal(params);
         thread->state |= PERL_ITHR_NONVIABLE;
-        S_ithread_free(aTHX_ thread); /* releases MUTEX */
+        S_ithread_free(aTHX_ thread);   /* Releases MUTEX */
 #ifndef WIN32
         if (ckWARN_d(WARN_THREADS)) {
             if (rc_stack_size) {
@@ -1064,7 +1064,7 @@ ithread_join(...)
         ithread *thread;
         ithread *current_thread;
         int join_err;
-        AV *params;
+        AV *params = NULL;
         int len;
         int ii;
 #ifdef WIN32
@@ -1120,7 +1120,7 @@ ithread_join(...)
         MUTEX_LOCK(&thread->mutex);
         /* Get the return value from the call_sv */
         /* Objects do not survive this process - FIXME */
-        {
+        if (! (thread->gimme & G_VOID)) {
             AV *params_copy;
             PerlInterpreter *other_perl;
             CLONE_PARAMS clone_params;
@@ -1147,7 +1147,7 @@ ithread_join(...)
         if (! (thread->state & PERL_ITHR_DIED)) {
             S_ithread_clear(aTHX_ thread);
         }
-        S_ithread_free(aTHX_ thread); /* releases MUTEX */
+        S_ithread_free(aTHX_ thread);   /* Releases MUTEX */
 
         /* If no return values, then just return */
         if (! params) {
@@ -1217,8 +1217,7 @@ ithread_detach(...)
         {
             S_ithread_clear(aTHX_ thread);
         }
-        S_ithread_free(aTHX_ thread); /* releases MUTEX */
-
+        S_ithread_free(aTHX_ thread);   /* Releases MUTEX */
 
 
 void
@@ -1392,6 +1391,9 @@ ithread_set_stack_size(...)
         if (sv_isobject(ST(0))) {
             Perl_croak(aTHX_ "Cannot change stack size of an existing thread");
         }
+        if (! looks_like_number(ST(1))) {
+            Perl_croak(aTHX_ "Stack size must be numeric");
+        }
 
         old_size = MY_POOL.default_stack_size;
         MY_POOL.default_stack_size = S_good_stack_size(aTHX_ SvIV(ST(1)));