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'; | |
02548dbe | 10 | require './test.pl'; |
624c42e2 | 11 | set_up_inc('../lib'); |
9b599b2a | 12 | } |
0994c4d0 | 13 | |
02548dbe NC |
14 | use strict; |
15 | ||
0ecd3ba2 MG |
16 | $| = 1; |
17 | ||
45d74e11 NC |
18 | my @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], | |
df0bd2f4 | 35 | # see if implicit close preserves $? |
45d74e11 | 36 | [ 0, 512, '{ local *F; open F, q[TEST]; close F; $!=0 } die;'], |
9b599b2a GS |
37 | ); |
38 | ||
45d74e11 | 39 | plan(tests => scalar @tests); |
9b599b2a | 40 | |
e08e1e1d JM |
41 | my $vms_exit_mode = 0; |
42 | ||
43 | if ($^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 | ||
ffbead30 | 59 | # Dump any error messages from the dying processes off to a temp file. |
02548dbe NC |
60 | my $tempfile = tempfile(); |
61 | open STDERR, '>', $tempfile or die "Can't open temp error file $tempfile: $!"; | |
ffbead30 | 62 | |
45d74e11 NC |
63 | foreach my $test (@tests) { |
64 | my($bang, $query, $code) = @$test; | |
df0bd2f4 | 65 | $code ||= 'die;'; |
ffbead30 MS |
66 | if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^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 | ||
e08e1e1d JM |
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; | |
9b599b2a | 77 | |
02548dbe NC |
78 | is($exit, (($bang || ($query >> 8) || 255) << 8), |
79 | sprintf "exit = 0x%04x bang = 0x%04x query = 0x%04x", $exit, $bang, $query); | |
9b599b2a | 80 | } |
02548dbe | 81 | |
ffbead30 | 82 | close STDERR; |