[perl #78000] [PATCH] Upgrade to threads 1.79

  Attached is a revised patch to upgrade to v1.79.  I needed to fix
  the tests in the newly added t/kill2.t file.  The blead version will
  be 1.79_01.

5 files changed, 119 insertions, 11 deletions

diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm
index 8654f9f6f5..175b8df26c 100644
--- a/dist/threads/lib/threads.pm
+++ b/dist/threads/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.77_03';
+our $VERSION = '1.79_01';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.77
+This document describes threads version 1.79
 
 =head1 SYNOPSIS
 
@@ -1005,6 +1005,12 @@ mutexes that are needed to control functionality within the L<threads> module.
 For this reason, the use of C<END> blocks in threads is B<strongly>
 discouraged.
 
+=item Open directory handles
+
+Spawning threads with open directory handles (see
+L<opendir|perlfunc/"opendir DIRHANDLE,EXPR">) will crash the interpreter.
+L<[perl #75154]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=75154>
+
 =item Perl Bugs and the CPAN Version of L<threads>
 
 Support for threads extends beyond the code in this module (i.e.,
@@ -1034,7 +1040,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.77/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.79/threads.pm>
 
 Source repository:
 L<http://code.google.com/p/threads-shared/>
diff --git a/dist/threads/t/exit.t b/dist/threads/t/exit.t
index 29c3dca0da..208f7b3b62 100644
--- a/dist/threads/t/exit.t
+++ b/dist/threads/t/exit.t
@@ -48,7 +48,7 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 1.77;' .
+run_perl(prog => 'use threads 1.79;' .
                  'threads->exit(86);' .
                  'exit(99);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -98,7 +98,7 @@ $rc = $thr->join();
 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
 
 
-run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.79 qw(exit thread_only);' .
                  'threads->create(sub { exit(99); })->join();' .
                  'exit(86);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -108,7 +108,7 @@ run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
     is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 }
 
-my $out = run_perl(prog => 'use threads 1.77;' .
+my $out = run_perl(prog => 'use threads 1.79;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '});' .
@@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 1.77;' .
 like($out, '1 finished and unjoined', "exit(status) in thread");
 
 
-$out = run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.79 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
 
 
-run_perl(prog => 'use threads 1.77;' .
+run_perl(prog => 'use threads 1.79;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .
diff --git a/dist/threads/t/kill2.t b/dist/threads/t/kill2.t
new file mode 100644
index 0000000000..8eac55bc5a
--- /dev/null
+++ b/dist/threads/t/kill2.t
@@ -0,0 +1,91 @@
+use strict;
+use warnings;
+
+BEGIN {
+    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
+
+    use Config;
+    if (! $Config{'useithreads'}) {
+        skip_all(q/Perl not compiled with 'useithreads'/);
+    }
+}
+
+use ExtUtils::testlib;
+
+use threads;
+
+BEGIN {
+    if (! eval 'use threads::shared; 1') {
+        skip_all('threads::shared not available');
+    }
+
+    local $SIG{'HUP'} = sub {};
+    my $thr = threads->create(sub {});
+    eval { $thr->kill('HUP') };
+    $thr->join();
+    if ($@ && $@ =~ /safe signals/) {
+        skip_all('Not using safe signals');
+    }
+
+    plan(3);
+};
+
+fresh_perl_is(<<'EOI', 'ok', { }, 'No signal handler in thread');
+    use threads;
+    use Thread::Semaphore;
+    my $sema = Thread::Semaphore->new(0);
+    my $test = sub {
+        my $sema = shift;
+        $sema->up();
+        while(1) { sleep(1); }
+    };
+    my $thr = threads->create($test, $sema);
+    $sema->down();
+    $thr->detach();
+    eval {
+        $thr->kill('STOP');
+    };
+    print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok');
+EOI
+
+fresh_perl_is(<<'EOI', 'ok', { }, 'Handler to signal mismatch');
+    use threads;
+    use Thread::Semaphore;
+    my $sema = Thread::Semaphore->new(0);
+    my $test = sub {
+        my $sema = shift;
+        $SIG{'TERM'} = sub { threads->exit() };
+        $sema->up();
+        while(1) { sleep(1); }
+    };
+    my $thr = threads->create($test, $sema);
+    $sema->down();
+    $thr->detach();
+    eval {
+        $thr->kill('STOP');
+    };
+    print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok');
+EOI
+
+fresh_perl_is(<<'EOI', 'ok', { }, 'Handler and signal match');
+    use threads;
+    use Thread::Semaphore;
+    my $sema = Thread::Semaphore->new(0);
+    my $test = sub {
+        my $sema = shift;
+        $SIG{'STOP'} = sub { threads->exit() };
+        $sema->up();
+        while(1) { sleep(1); }
+    };
+    my $thr = threads->create($test, $sema);
+    $sema->down();
+    $thr->detach();
+    eval {
+        $thr->kill('STOP');
+    };
+    print((! $@) ? 'ok' : 'not ok');
+EOI
+
+exit(0);
+
+# EOF
diff --git a/dist/threads/t/thread.t b/dist/threads/t/thread.t
index b390215f16..32c50b8d4d 100644
--- a/dist/threads/t/thread.t
+++ b/dist/threads/t/thread.t
@@ -161,7 +161,7 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 1.77;' .
+run_perl(prog => 'use threads 1.79;' .
                  'sub a{threads->create(shift)} $t = a sub{};' .
                  '$t->tid; $t->join; $t->tid',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index f4e6946e35..6c38bdc3fb 100644
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -1342,6 +1342,7 @@ ithread_kill(...)
         ithread *thread;
         char *sig_name;
         IV signal;
+        int no_handler = 1;
     CODE:
         /* Must have safe signals */
         if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) {
@@ -1371,11 +1372,21 @@ ithread_kill(...)
         MUTEX_LOCK(&thread->mutex);
         if (thread->interp) {
             dTHXa(thread->interp);
-            PL_psig_pend[signal]++;
-            PL_sig_pending = 1;
+            if (PL_psig_pend && PL_psig_ptr[signal]) {
+                PL_psig_pend[signal]++;
+                PL_sig_pending = 1;
+                no_handler = 0;
+            }
+        } else {
+            /* Ignore signal to terminated thread */
+            no_handler = 0;
         }
         MUTEX_UNLOCK(&thread->mutex);
 
+        if (no_handler) {
+            Perl_croak(aTHX_ "Signal %s received in thread %"UVuf", but no signal handler set.", sig_name, thread->tid);
+        }
+
         /* Return the thread to allow for method chaining */
         ST(0) = ST(0);
         /* XSRETURN(1); - implied */