in reply to exit value not passed back

My test program 
if( @ARGV ){
    $SIG{INT} = \&exit_gracefully;
    for(1..10){
        warn "called sleeping $_";
        select undef, undef, undef, 0.5;
    }
    exit 1;
} else {
    warn "calling system\n";
    system ( $^X, __FILE__ , 'called');

    $exit_val = $? >> 8;

    warn "\n exit_val $exit_val";
}

sub exit_gracefully
{
    $SIG{INT} = \&exit_gracefully;
    print "@ARGV Program interrupted .. \n";
    exit (2);
}
__END__

[download]
On perl v5.8.4 built for MSWin32-x86-multi-thread under cmd.exe (Windows XP SP1a), it looks as though calling.pl gets interrupted and then delivers a SIGINT to called.pl. 
C:\>perl \dev\loose\perlfunc.exit.pl
calling system
called sleeping 1 at \dev\loose\perlfunc.exit.pl line 4.
called sleeping 2 at \dev\loose\perlfunc.exit.pl line 4.
called sleeping 3 at \dev\loose\perlfunc.exit.pl line 4.
called sleeping 4 at \dev\loose\perlfunc.exit.pl line 4.
called sleeping 5 at \dev\loose\perlfunc.exit.pl line 4.
Terminating on signal SIGINT(2)

C:\>called Program interrupted ..

C:\>

[download]
On perl v5.8.4 built for i386-linux-thread-multi under bash, I get results as expected 
user@host:~$ perl perlfunc.exit.pl
calling system
called sleeping 1 at perlfunc.exit.pl line 4.
called sleeping 2 at perlfunc.exit.pl line 4.
called sleeping 3 at perlfunc.exit.pl line 4.
called sleeping 4 at perlfunc.exit.pl line 4.
called Program interrupted ..

 exit_val 2 at perlfunc.exit.pl line 14.
user@host:~$
user@host:~$

[download]

MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
** The third rule of perl club is a statement of fact: pod is sexy.

Replies are listed 'Best First'.
Re^2: exit value not passed back
by mags (Initiate) on Oct 06, 2004 at 13:33 UTC
    I tried your program and it works fine (I use Solaris), I guess the problem lies in the fact that my perl script is called from another perl script.

    So if we add the following test code:
    #######
    # calling.pl

    eval { system ("test.pl"); };
    $exit_val = $? >> 8;

    to call your previous test code. If I then run calling.pl and use ctrl-c, I get returned value as 0.

    Mags
[reply]
Re^2: exit value not passed back
by mags (Initiate) on Oct 08, 2004 at 12:04 UTC
    Here is the full code I used (I have tried also the fork-exec method) but no luck:

    ### Calling.pl
    #!/usr/local/bin/perl -w

    #eval { system ("./called.pl"); };
    #$exit_value = $?;

    #$exit_value = system ("./called.pl");

    if ($pid2 = fork) {
    # parent catches INT
    print "IN PAR\n";
    local $SIG{INT} = sub { print "In parent ...wait\n" };
    waitpid ($pid2, 0);
    }
    else {
    die "cannot fork: $!" unless defined $pid2;
    eval { exec ("./called.pl"); };
    }

    print "\nE-at = $@\n";
    print "\nE-! = $!\n";

    print "\nE = $exit_value\n";

    $exit_value = $exit_value >> 8; # Get the higher byte which has the real exit value
    print "\nE1 = $exit_value\n";


    ### called.pl
    #!/usr/local/bin/perl -w

    if (@ARGV) {
    $SIG{INT} = \&exit_gracefully;
    for(1..10){
    warn "called sleeping $_";
    select undef, undef, undef, 0.5;
    }
    exit 1;
    } else {
    warn "calling system\n";
    system ( $^X, __FILE__ , 'called');

    $exit_val = $? >> 8;

    warn "\n exit_val $exit_val";
    }

    sub exit_gracefully
    {
    $SIG{INT} = \&exit_gracefully;
    print "@ARGV Program interrupted .. \n";
    exit (3);
    }

    ###Output.txt

    IN PAR
    calling system
    called sleeping 1 at ./called.pl line 6.
    called sleeping 2 at ./called.pl line 6.
    called sleeping 3 at ./called.pl line 6.
    called sleeping 4 at ./called.pl line 6.
    ^Ccalled Program interrupted ..
    In parent ...wait

    exit_val 3 at ./called.pl line 16.

    E-at =

    E-! = Interrupted system call
    Use of uninitialized value in concatenation (.) or string at ./calling.pl line 22.

    E =

    Use of uninitialized value in right bitshift (>>) at ./calling.pl line 24.

    E1 = 0
[reply]

In Section Seekers of Perl Wisdom