setalarm () явно не вызывает мой обработчик

Question

Я установил многопоточное приложение, используя потоки Perl, и пытаюсь определить время ожидания в потоке (поток должен пройти через несколько системных вызовов, которые могли бы истечь, и мне нужно знать, когда он остановился).

Я попытался использовать alarm () и столкнулся с хорошо задокументированными проблемами, когда сигнал Alarm принимается потоком 0, а не потоком, который вызвал сигнал тревоги.Поэтому я перешел к использованию Alarm :: Concurrent.

use threads ('yield',
             'stack_size' => 64*4096,
             'exit' => 'threads_only',
             'stringify');


use Alarm::Concurrent qw(setalarm clearalarm);

threads->create(\&MyThreadFunc,1);
threads->create(\&MyThreadFunc,1);
threads->create(\&MyThreadFunc,5);
threads->create(\&MyThreadFunc,5);

sub MyThreadFunc {

    my $result = "Never Ran";
    my $timeToSleep = $_[0];
    my $tid = threads->tid();
    eval {
            setalarm  3, sub { die "Timedout\n" };
            sleep ($timeToSleep);
            clearalarm;
            $result = "TID $tid EXITED\n";
    };
    if ($@ eq "Timedout\n")
    {
            $result = "TID $tid TIMED OUT\n";
    }
    elsif ($@)
    {
            $result = "$@";
    }
    print "Thread returning $result";
    return $result;
}

 while (scalar threads::list(threads::running))
 {
 foreach my $thread (threads->list(threads::joinable)) { $thread->join(); }
 }

То, что я ожидал:
Я ожидал, что потоки TID 1 и 2 выйдут нормально, а потоки 3 и 4 - по пути TimedOut (потому что был бы вызван сигнал тревоги и eval ()поймал бы кубик "Timedout \ n". Вместо этого они все пошли по пути EXITED.

Thread returning TID 1 EXITED
Thread returning TID 2 EXITED
Thread returning TID 4 EXITED
Thread returning TID 3 EXITED

Answer 1

Согласно документации по темам :

Сигналы перехватываются основным потоком (ID потока = 0) скрипта. Поэтому установка обработчиков сигналов в потоках для других целей чем THREAD SIGNALING, как описано выше, не достигнет того, что предназначенный.

Это особенно верно, если вы пытаетесь поймать SIGALRM в потоке. к обрабатывать сигналы тревоги в потоках, настраивать обработчик сигналов в основном потоке, и затем используйте THREAD SIGNALING для передачи сигнала в поток:

my $thr = threads->create(sub {
  threads->yield();
  eval {
      $SIG{ALRM} = sub { die("Timeout\n"); };
      alarm(10);
      ...  # Do work here
      alarm(0);
  };
  if ($@ =~ /Timeout/) {
      warn("Task in thread timed out\n");
  }   
};  

# Set signal handler to relay SIGALRM to thread   
$SIG{ALRM} = sub { $thr->kill('ALRM') };   ... # Main thread continues working

Вот пример того, как его можно использовать:

use threads ('yield',
             'stack_size' => 64*4096,
             'exit' => 'threads_only',
             'stringify');
use feature qw(say);
use strict;
use warnings;
use Alarm::Concurrent qw(setalarm clearalarm);

{
    create_thread(sleep_time => 1, timeout => 3);
    create_thread(sleep_time => 1, timeout => 3);
    create_thread(sleep_time => 5, timeout => 3);
    create_thread(sleep_time => 5, timeout => 3);

    while (scalar threads::list(threads::running)) {
        foreach my $thread (threads->list(threads::joinable)) { $thread->join(); }
    }
}

sub create_thread {
    my (%options) = @_;

    my $thr = threads->create(\&MyThreadFunc, $options{sleep_time});
    setalarm $options{timeout}, sub {
        $thr->kill('SIGTERM');
    };
}

sub MyThreadFunc {
    my $result = "Never Ran";
    my $timeToSleep = $_[0];
    my $tid = threads->tid();
    eval {
        local $SIG{TERM} = sub { die "Timedout\n" };
        sleep ($timeToSleep);
        $result = "TID $tid EXITED\n";
    };
    if ($@ eq "Timedout\n") {
        $result = "TID $tid TIMED OUT\n";
    }
    elsif ($@) {
        $result = "$@";
    }
    print "Thread returning $result";
    return $result;
}

выход

Thread returning TID 1 EXITED
Thread returning TID 2 EXITED
Thread returning TID 3 TIMED OUT
Thread returning TID 4 TIMED OUT