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