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