1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# 4*0Sstevel@tonic-gate# Verify that C<die> return the return code 5*0Sstevel@tonic-gate# -- Robin Barker <rmb@cise.npl.co.uk> 6*0Sstevel@tonic-gate# 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateBEGIN { 9*0Sstevel@tonic-gate chdir 't' if -d 't'; 10*0Sstevel@tonic-gate @INC = '../lib'; 11*0Sstevel@tonic-gate} 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gateif ($^O eq 'mpeix') { 14*0Sstevel@tonic-gate print "1..0 # Skip: broken on MPE/iX\n"; 15*0Sstevel@tonic-gate exit 0; 16*0Sstevel@tonic-gate} 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gate$| = 1; 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gateuse strict; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gatemy %tests = ( 23*0Sstevel@tonic-gate 1 => [ 0, 0], 24*0Sstevel@tonic-gate 2 => [ 0, 1], 25*0Sstevel@tonic-gate 3 => [ 0, 127], 26*0Sstevel@tonic-gate 4 => [ 0, 128], 27*0Sstevel@tonic-gate 5 => [ 0, 255], 28*0Sstevel@tonic-gate 6 => [ 0, 256], 29*0Sstevel@tonic-gate 7 => [ 0, 512], 30*0Sstevel@tonic-gate 8 => [ 1, 0], 31*0Sstevel@tonic-gate 9 => [ 1, 1], 32*0Sstevel@tonic-gate 10 => [ 1, 256], 33*0Sstevel@tonic-gate 11 => [ 128, 0], 34*0Sstevel@tonic-gate 12 => [ 128, 1], 35*0Sstevel@tonic-gate 13 => [ 128, 256], 36*0Sstevel@tonic-gate 14 => [ 255, 0], 37*0Sstevel@tonic-gate 15 => [ 255, 1], 38*0Sstevel@tonic-gate 16 => [ 255, 256], 39*0Sstevel@tonic-gate # see if implicit close preserves $? 40*0Sstevel@tonic-gate 17 => [ 0, 512, '{ local *F; open F, q[TEST]; close F; $!=0 } die;'], 41*0Sstevel@tonic-gate); 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gatemy $max = keys %tests; 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gateprint "1..$max\n"; 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gate# Dump any error messages from the dying processes off to a temp file. 48*0Sstevel@tonic-gateopen(STDERR, ">die_exit.err") or die "Can't open temp error file: $!"; 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gateforeach my $test (1 .. $max) { 51*0Sstevel@tonic-gate my($bang, $query, $code) = @{$tests{$test}}; 52*0Sstevel@tonic-gate $code ||= 'die;'; 53*0Sstevel@tonic-gate if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { 54*0Sstevel@tonic-gate system(qq{$^X -e "\$! = $bang; \$? = $query; $code"}); 55*0Sstevel@tonic-gate } 56*0Sstevel@tonic-gate else { 57*0Sstevel@tonic-gate system(qq{$^X -e '\$! = $bang; \$? = $query; $code'}); 58*0Sstevel@tonic-gate } 59*0Sstevel@tonic-gate my $exit = $?; 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gate # VMS exit code 44 (SS$_ABORT) is returned if a program dies. We only get 62*0Sstevel@tonic-gate # the severity bits, which boils down to 4. See L<perlvms/$?>. 63*0Sstevel@tonic-gate $bang = 4 if $^O eq 'VMS'; 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate printf "# 0x%04x 0x%04x 0x%04x\n", $exit, $bang, $query; 66*0Sstevel@tonic-gate print "not " unless $exit == (($bang || ($query >> 8) || 255) << 8); 67*0Sstevel@tonic-gate print "ok $test\n"; 68*0Sstevel@tonic-gate} 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gateclose STDERR; 71*0Sstevel@tonic-gateEND { 1 while unlink 'die_exit.err' } 72*0Sstevel@tonic-gate 73