为什么我不从我的子进程中获取退出状态?

Ben*_*rds 1 perl posix fork

我有一个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");
    }
}
Run Code Online (Sandbox Code Playgroud)

退出子进程代码:

### 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);
    }
}
Run Code Online (Sandbox Code Playgroud)

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;
    }
}
Run Code Online (Sandbox Code Playgroud)

根据我所做的运行日志,我看到的行为是:

<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.
Run Code Online (Sandbox Code Playgroud)

我有使用Perl IPC运行命令的代码(代替system()调用,以获得更好的灵活性,可以正确地获取退出代码,您可以在日志文件的"用户命令"行中看到).

我在这里做错了什么?$?在这种情况下,为什么我无法取出退出状态?我在网上找到的例子似乎都表明这应该可行.

作为参考,我正在运行Perl v5.10.1.如果你觉得你需要查看其余的代码,这个Perl工具也是在GitHub上开源的:https://github.com/benrichards86/Verify/blob/master/verify.pl

mob*_*mob 6

如果$test_status是512,你打电话POSIX::_exit(512)吗?那是不对的.子进程应该POSIX::_exit使用0到255范围内的操作数进行调用,并且将该子进程的Perl父进程$?设置为exit-status << 8.

POSIX::_exit(512)相当于POSIX::_exit(512 % 256),或POSIX::_exit(0).