我有我的管理上有叉关闭多个进程的能力（高达规定的极限），监视它们Perl程序，当他们退出，叉掉额外的过程（再一次，到了极限），直到事情运行列表完成。 它工作正常，但由于某种原因，它似乎没有从我的子进程拿起正确的退出状态。
不工作的代码使用Perl的fork() ， waitpid()和子进程使用POSIX::_exit()退出。 下面是相关的代码中的一些摘录：
分叉代码：
# Initialize process if running in parallel mode
my $pid;
if ($options{'parallel'} > 0) {
log_status("Waiting to fork test #".$curr_test{'id'}."...\n");
# Here, wait for child processes to complete so we can fork off new ones without going over the specified limit
while ( keys(%children) >= $options{'parallel'}) {
my $kid = waitpid(-1, 0);
my $kid_status = $?;
if ($kid > 0) {
log_status("Child process (PID ".$kid.", test ".$children{$kid}.") exited with status ".$kid_status.".\n");
$error_status |= $kid_status;
delete $children{$kid};
}
}
$pid = fork();
tdie("Unable to fork!\n") unless defined $pid;
if ($pid != 0) {
# I'm the parent
$is_child = 0;
log_status("Forked child process (PID ".$pid.").\n");
$children{$pid} = $curr_test{'logstr'};
next TEST_LOOP;
}
else {
# I'm the child
$is_child = 1;
log_status("Starting test = ".$curr_test{'logstr'}."\n");
}
}
退出子进程的代码：
### finish_child() ###
# Handles exiting the script, like the finish() function, but only when running as a child process in parallel mode.
# Parameters:
# - The error code to exit with
###
sub finish_child( $ ) {
my ($error_status) = @_;
# If running in parallel mode, exit this fork
if ($options{'parallel'} > 0) {
log_status("Entering: ".Cwd::abs_path("..")."\n");
chdir "..";
log_status("Exiting with status: ".$error_status."\n");
POSIX::_exit($error_status);
}
}
这里就是finish_child()被调用在我的例子来看：
# If build failed, log status and gracefully clean up logfiles, then continue to next test in list.
if ($test_status > 0) {
$email_subject = "Build failed!";
log_status("Build of ".$testline." FAILED.\n");
tlog(1, "Build of ".$testline." FAILED.\n");
log_status("Entering: ".Cwd::abs_path("..")."\n");
chdir "..";
log_report(\%curr_test, $test_status);
# Print out pass/fail status for each test as it completes
$quietmode = $options{'quiet'}; # Backup quiet mode setting
$options{'quiet'} = 0;
if ($test_status == 0) {
log_status("Test ".$testline." PASSED.\n");
tlog(0, "Test ".$testline." PASSED.\n");
}
else {
log_status("Test ".$testline." FAILED.\n");
tlog(1, "Test ".$testline." FAILED.\n");
}
$options{'quiet'} = $quietmode; # Restore quiet mode setting
finish_logs();
# Link logs to global area and rename if running multiple tests
system("ln -sf ".$root_dir."/verify/".$curr_test{'id'}."/".$verify::logfile." ../".(($test_status > 0) ? "fail".$curr_test{'id'}.".log" : "pass".$curr_test{'id'}.".log" )) if (@tests > 1);
if ($options{'parallel'} > 0 && $pid == 0) {
# If we're in parallel mode and I'm a child process, I should exit, instead of continuing to loop.
finish_child($test_status);
}
else {
# If we're not in parallel mode, I should continue to loop.
next TEST_LOOP;
}
}
下面是我根据日志从运行我没有看到的行为：
<Parent> Waiting for all child processes to complete...
<Child> [PID 28657] Entering: <trimmed>
<Child> [PID 28657] Running user command: make --directory <trimmed> TARGET=build BUILD_DIR=<trimmed> RUN_DIR=<trimmed>
<Child> [PID 28657] User command finished with return code: 512
<Child> [PID 28657] Build step finished with return code 512
<Child> [PID 28657] Entering: <trimmed>
<Child> [PID 28657] Build of rx::basic(1) FAILED.
<Child> [PID 28657] Entering: <trimmed>
<Child> [PID 28657] Test rx::basic(1) FAILED.
<Child> [PID 28657] Closing log file.
<Child> [PID 28657] Closing error log file.
<Child> [PID 28657] Entering: <trimmed>
<Parent> Child process (PID 28657, test rx::basic(1)) exited with status 0.
我有一个使用Perl的IPC运行命令（代替的代码system()调用，有更多的灵活性，妥善拿起退出代码，您可以从日志文件中的“用户命令”行看。
还有什么比我做错了，在这里？ 我为什么不能够拿起从退出状态$? 在这种情况下？ 我在网上找到的例子都似乎表明，这应该能正常运行。
作为参考，我跑Perl v5.10.1 。 这Perl的工具也是开源GitHub上，如果你觉得你需要通过代码的其余部分看： https://github.com/benrichards86/Verify/blob/master/verify.pl
