Commit | Line | Data |
9b599b2a |
1 | #!./perl |
2 | |
3 | # |
4 | # Verify that C<die> return the return code |
abb363a1 |
5 | # -- Robin Barker |
9b599b2a |
6 | # |
7 | |
8 | BEGIN { |
9 | chdir 't' if -d 't'; |
20822f61 |
10 | @INC = '../lib'; |
9b599b2a |
11 | } |
0994c4d0 |
12 | |
13 | if ($^O eq 'mpeix') { |
14 | print "1..0 # Skip: broken on MPE/iX\n"; |
15 | exit 0; |
16 | } |
17 | |
0ecd3ba2 |
18 | $| = 1; |
19 | |
9b599b2a |
20 | use strict; |
21 | |
22 | my %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], |
df0bd2f4 |
39 | # see if implicit close preserves $? |
a8710ca1 |
40 | 17 => [ 0, 512, '{ local *F; open F, q[TEST]; close F; $!=0 } die;'], |
9b599b2a |
41 | ); |
42 | |
43 | my $max = keys %tests; |
44 | |
e08e1e1d |
45 | my $vms_exit_mode = 0; |
46 | |
47 | if ($^O eq 'VMS') { |
48 | if (eval 'require VMS::Feature') { |
49 | $vms_exit_mode = !(VMS::Feature::current("posix_exit")); |
50 | } else { |
51 | my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; |
52 | my $env_posix_ex = $ENV{'PERL_VMS_POSIX_EXIT'} || ''; |
53 | my $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; |
54 | my $posix_ex = $env_posix_ex =~ /^[ET1]/i; |
55 | if (($unix_rpt || $posix_ex) ) { |
56 | $vms_exit_mode = 0; |
57 | } else { |
58 | $vms_exit_mode = 1; |
59 | } |
60 | } |
61 | } |
62 | |
63 | |
9b599b2a |
64 | print "1..$max\n"; |
65 | |
ffbead30 |
66 | # Dump any error messages from the dying processes off to a temp file. |
67 | open(STDERR, ">die_exit.err") or die "Can't open temp error file: $!"; |
68 | |
9b599b2a |
69 | foreach my $test (1 .. $max) { |
df0bd2f4 |
70 | my($bang, $query, $code) = @{$tests{$test}}; |
71 | $code ||= 'die;'; |
ffbead30 |
72 | if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { |
73 | system(qq{$^X -e "\$! = $bang; \$? = $query; $code"}); |
74 | } |
75 | else { |
76 | system(qq{$^X -e '\$! = $bang; \$? = $query; $code'}); |
77 | } |
78 | my $exit = $?; |
79 | |
e08e1e1d |
80 | # The legacy VMS exit code 44 (SS$_ABORT) is returned if a program dies. |
81 | # We only get the severity bits, which boils down to 4. See L<perlvms/$?>. |
82 | $bang = 4 if $vms_exit_mode; |
9b599b2a |
83 | |
d289e7db |
84 | printf "# 0x%04x 0x%04x 0x%04x\n", $exit, $bang, $query; |
85 | print "not " unless $exit == (($bang || ($query >> 8) || 255) << 8); |
9b599b2a |
86 | print "ok $test\n"; |
87 | } |
88 | |
ffbead30 |
89 | close STDERR; |
90 | END { 1 while unlink 'die_exit.err' } |
91 | |