More tweaks to threads 1.37, by Jerry D. Hedden

p4raw-id: //depot/perl@28604

5 files changed, 48 insertions, 51 deletions

diff --git a/ext/threads/Changes b/ext/threads/Changes
index 0dc2bf3dae..34cff5e319 100755
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,6 +1,6 @@
 Revision history for Perl extension threads.
 
-1.37 Thu Jul 20 13:33:33 EDT 2006
+1.37 Fri Jul 21 10:51:36 EDT 2006
 	- Revert 'exit' behavior with override
 
 1.36 Mon Jul 10 15:58:13 EDT 2006
diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
index 021d751952..f91b35158b 100644
--- a/ext/threads/t/exit.t
+++ b/ext/threads/t/exit.t
@@ -56,9 +56,9 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 1.37;
-                  threads->exit(86);
-                  exit(99);',
+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');
@@ -104,49 +104,45 @@ $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);',
+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)");
-}
-
-
-run_perl(prog => 'use threads 1.37;
-                  threads->create(sub {
-                     $SIG{__WARN__} = sub { exit(99); };
-                     die();
-                  })->join();
-                  exit(86);',
+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)");
+
+
+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");
diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index b1046165eb..5fb24259a3 100644
--- a/ext/threads/t/thread.t
+++ b/ext/threads/t/thread.t
@@ -171,9 +171,9 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 1.37;
-                  sub a{threads->create(shift)} $t = a sub{};
-                  $t->tid; $t->join; $t->tid',
+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' ]);
 is($?, 0, 'coredump in global destruction');
diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index bec14b6e63..656435947f 100755
--- a/ext/threads/threads.pm
+++ b/ext/threads/threads.pm
@@ -438,7 +438,7 @@ strongly discouraged.
 
 If C<exit()> really is needed, then consider using the following:
 
-    threads->exit() if $threads::threads;   # Thread friendly
+    threads->exit() if threads->can('exit');   # Thread friendly
     exit(status);
 
 =item use threads 'exit' => 'thread_only'
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index d0a8f4ab89..2765589eac 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -199,13 +199,16 @@ S_ithread_destruct(pTHX_ ithread *thread)
 
 
 /* Warn if exiting with any unjoined threads */
-int
+static int
 S_exit_warning(pTHX)
 {
-    int veto_cleanup = 0;
+    int veto_cleanup;
 
     MUTEX_LOCK(&create_destruct_mutex);
-    if (running_threads || joinable_threads) {
+    veto_cleanup = (running_threads || joinable_threads);
+    MUTEX_UNLOCK(&create_destruct_mutex);
+
+    if (veto_cleanup) {
         if (ckWARN_d(WARN_THREADS)) {
             Perl_warn(aTHX_ "Perl exited with active threads:\n\t%"
                             IVdf " running and unjoined\n\t%"
@@ -215,9 +218,7 @@ S_exit_warning(pTHX)
                             joinable_threads,
                             detached_threads);
         }
-        veto_cleanup = 1;
     }
-    MUTEX_UNLOCK(&create_destruct_mutex);
 
     return (veto_cleanup);
 }