1#!./perl -w 2 3# 4# Verify that C<die> return the return code 5# -- Robin Barker 6# 7 8BEGIN { 9 chdir 't' if -d 't'; 10 require './test.pl'; 11 set_up_inc('../lib'); 12} 13 14use strict; 15 16$| = 1; 17 18my @tests = ( 19 [ 0, 0], 20 [ 0, 1], 21 [ 0, 127], 22 [ 0, 128], 23 [ 0, 255], 24 [ 0, 256], 25 [ 0, 512], 26 [ 1, 0], 27 [ 1, 1], 28 [ 1, 256], 29 [ 128, 0], 30 [ 128, 1], 31 [ 128, 256], 32 [ 255, 0], 33 [ 255, 1], 34 [ 255, 256], 35 # see if implicit close preserves $? 36 [ 0, 512, '{ local *F; open F, q[TEST]; close F; $!=0 } die;'], 37); 38 39plan(tests => scalar @tests); 40 41my $vms_exit_mode = 0; 42 43if ($^O eq 'VMS') { 44 if (eval 'require VMS::Feature') { 45 $vms_exit_mode = !(VMS::Feature::current("posix_exit")); 46 } else { 47 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; 48 my $env_posix_ex = $ENV{'PERL_VMS_POSIX_EXIT'} || ''; 49 my $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 50 my $posix_ex = $env_posix_ex =~ /^[ET1]/i; 51 if (($unix_rpt || $posix_ex) ) { 52 $vms_exit_mode = 0; 53 } else { 54 $vms_exit_mode = 1; 55 } 56 } 57} 58 59# Dump any error messages from the dying processes off to a temp file. 60my $tempfile = tempfile(); 61open STDERR, '>', $tempfile or die "Can't open temp error file $tempfile: $!"; 62 63foreach my $test (@tests) { 64 my($bang, $query, $code) = @$test; 65 $code ||= 'die;'; 66 if ($^O eq 'MSWin32' || $^O eq 'VMS') { 67 system(qq{$^X -e "\$! = $bang; \$? = $query; $code"}); 68 } 69 else { 70 system(qq{$^X -e '\$! = $bang; \$? = $query; $code'}); 71 } 72 my $exit = $?; 73 74 # The legacy VMS exit code 44 (SS$_ABORT) is returned if a program dies. 75 # We only get the severity bits, which boils down to 4. See L<perlvms/$?>. 76 $bang = 4 if $vms_exit_mode; 77 78 is($exit, (($bang || ($query >> 8) || 255) << 8), 79 sprintf "exit = 0x%04x bang = 0x%04x query = 0x%04x", $exit, $bang, $query); 80} 81 82close STDERR; 83