我有一个我正在管理的 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