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 18my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl'; 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 47foreach my $test (1 .. $max) { 48 my($bang, $query, $code) = @{$tests{$test}}; 49 $code ||= 'die;'; 50 my $exit = 51 ($^O eq 'MSWin32' 52 ? system qq($perl -e "\$! = $bang; \$? = $query; $code" 2> nul) 53 : system qq($perl -e '\$! = $bang; \$? = $query; $code' 2> /dev/null)); 54 55 printf "# 0x%04x 0x%04x 0x%04x\n", $exit, $bang, $query; 56 print "not " unless $exit == (($bang || ($query >> 8) || 255) << 8); 57 print "ok $test\n"; 58} 59 60