Question

我想按照以下方式做点什么：

my $sema = Thread::Semaphore->new(8);

while(@compsCopy)
{
  my $thread1 = threads->create('Build', (shift @compsCopy), "clean");
}

sub FfsBuild {

    $sema->down();

    my ($comp, $action) = @_;

    my $cmd = "$MAKE $MAKE_INVOCATION_PATH/$comp $action";
    my $retCode = system($cmd);
    push(@retCodes, $retCode);

    print "\n\t\t**** ERROR IN $comp ****\n" unless $retCode == 0;
    print "added proc $comp\n";    

    $sema->up();
    return $retCode;
}

这对于前10-20个目录似乎工作得很好......但最终我得到了：

Perl exited with active threads:
        364 running and unjoined
        14 finished and unjoined
        0 running and detached

C:\dev>make: Leaving directory `/cygdrive/C/dev/dir0'
make: Leaving directory `/cygdrive/C/dev/dir1'
make: Leaving directory `/cygdrive/C/dev/dir2'
make: Leaving directory `/cygdrive/C/dev/dir3'
make: Leaving directory `/cygdrive/C/dev/dir4'
make: Leaving directory `/cygdrive/C/dev/dir5'
make: Leaving directory `/cygdrive/C/dev/dir6'
make: Leaving directory `/cygdrive/C/dev/dir7'

我在哪里乱搞？

Answer 1

问题在于你不要等待你的线程完成。在底部添加以下内容可以解决问题：

$_->join for threads->list;

你不应该创建378个线程，然后一次只执行8个！多么浪费！运行这样的代码的人说Perl线程效率低下。创建一个工作池并将工作分配给它们。

use constant NUM_WORKERS => 8;

use Thread::Queue 3.01 qw( );

sub worker {
    my ($job) = @_;
    FfsBuild($job, 'clean');
}

{
   my $q = Thread::Queue->new();

   for (1..NUM_WORKERS) {
      async {
         while (defined(my $job = $q->dequeue()) {
            worker($job);
         }
      };
   }

   $q->enqueue($_) for @compsCopy;

   # When you're done adding to the queue.
   $q->end();
   $_->join() for threads->list();
}

FfsBuild就是你没有信号量的东西。

Answer 2

使用Perl进行线程处理有点困难（并且效率也很低。如果没有充分的理由，请不要这样做。）

除了主线程之外的每个线程都必须在退出之前join编辑，或者detach编辑。在退出进程之前，您仍应确保线程终止。

所以像threads->create(...)->detach这样的东西应该在这里工作，但我认为最好加入：

my @threads;
for my $job (@jobs) {
    push @threads, threads->create(\&worker, $job);
}

# wait until all have completed
$_->join for @threads;

但是，您可能希望在程序开始时踢一些工作人员，并通过Thread::Queue来提供作业 - 每个线程都是当前解释器状态的完整克隆，这往往是使用不必要的大量内存。运行数百个Perl线程可能不太有用。

线程脚本过早退出

2 个答案: