未找到信号处理程序

Question

由于某种原因，线程似乎无法找到 $SIG{'KILL') 信号。我从http://www.perlmonks.org/index.pl?node_id=557219这里的评论中得到代码，这是在 Windows 上。

use strict;
use warnings;

use threads;

sub test_sub{
    $SIG{'KILL'} = sub { threads->exit(); };
    while(1){}  
}

my $new_thread = threads->create('test_sub');

$new_thread->kill('KILL')->detach();

返回

Signal KILL received in thread 1, but no signal handler set. at test1.pl line 13.
Perl exited with active threads:
        1 running and unjoined
        0 finished and unjoined
        0 running and detached

编辑：看起来我正在使用线程版本“1.43”。我不知道是不是这个问题，但我会尝试更新的版本。

Answer 1

可能导致您观察到的行为的竞争条件不止一种，而是两种：

• 您在孩子有机会设置信号处理程序之前发送 KILL 信号。

  下面，我使用同步来确保在发送信号之前创建信号处理程序。

• 您在信号处理程序有机会调用threads->exit 之前退出程序。

  为什么人们坚持使用->detach？

固定：

use strict;
use warnings;
use feature qw( say );

use threads;
use threads::shared;

sub test_handler {
    say sprintf "[%s %s] Starting thread", time, threads->tid;
    say sprintf "[%s %s] Doing stuff", time, threads->tid;
    sleep 4;
    say sprintf "[%s %s] Done doing stuff", time, threads->tid;
    say sprintf "[%s %s] Exiting thread", time, threads->tid;
}

sub create_thread(&) {
   my ($thread_func) = @_;

   # Reap any threads that might have exited.
   $_->join() for threads->list(threads::joinable);

   my $ready :shared = 0;
   my $thread = async {
      $SIG{KILL} = sub {
         say sprintf "[%s %s] Forcibly exiting thread", time, threads->tid;
         threads->exit();
      };

      # Signal creator that the thread is initialized.
      { lock $ready; $ready = 1; cond_signal($ready); }
      $thread_func->();
   };

   # Wait for the thread to finish initializing.    
   { lock $ready; while (!$ready) { cond_wait($ready); } }
   return $thread;
}

my $thread = create_thread(\&test_handler);

say sprintf "[%s %s] Sending KILL signal", time, threads->tid;
$thread->kill('KILL');

say sprintf "[%s %s] Doing stuff", time, threads->tid;
sleep(2);
say sprintf "[%s %s] Done doing stuff", time, threads->tid;

# Wait for threads to exit.
say sprintf "[%s %s] Waiting for threads to exit", time, threads->tid;
$_->join() for threads->list();
say sprintf "[%s %s] Exiting", time, threads->tid;

输出：

[1513212149 1] Starting thread
[1513212149 1] Doing stuff
[1513212149 0] Sending KILL signal
[1513212149 0] Doing stuff
[1513212151 0] Done doing stuff
[1513212151 0] Waiting for threads to exit
[1513212153 1] Forcibly exiting thread
[1513212153 0] Exiting

重要请注意，信号并未中断sleep。没有发送实际的 POSIX 信号^[1]（因为您只能将这些信号发送到进程），因此不能中断操作系统调用。相反，Perl 会主动检查是否在大多数 Perl 操作码之间发送了信号^[2]。但这意味着像 sleep、m// 和 XS 函数调用这样的长时间运行的操作码可能会无限期地延迟信号处理程序。

---

1. 你很幸运，因为你没有使用 POSIX 系统。
2. 前段时间，它曾经是在每个操作码之间，但检查的次数减少了。我认为 Perl 现在对每个语句检查一次。

Answer 2

这似乎是某种竞争条件，当有更多情况发生时它会起作用。

use warnings;
use strict;
use feature 'say';

use threads;
use threads::shared;

my $thread_handler_on :shared = 0;

sub test_handler {
    say "\tIn thread.";
    $SIG{'KILL'} = sub {
        $thread_handler_on = 1;
        say "\tSet flag, exiting the thread in handler";
        threads->exit();
    };
    sleep 3;
    say "\tSet handler";
    sleep 1;
    say "\tHandler done napping";
}

my $new_thread = threads->create( 'test_handler' );

sleep 1;

say "Sending 'kill' to thread";
$new_thread->kill('KILL')->detach();

sleep 5;

say "Did handler run: $thread_handler_on";

问题中的代码是正确的out of threads docs（以及detach）。 这打印出来

在线程中。 向线程发送“kill” 设置标志，退出处理程序中的线程 处理程序是否运行：1

如果没有主线程中的sleeps，我也会得到报告的行为。

请注意，这些“信号”不是通过内核发送的，Threads signalling

该模块提供的线程信号能力实际上并不通过操作系统发送信号。它在 Perl 级别模拟信号，以便在适当的线程中调用信号处理程序。