Commit | Line | Data |
14cf881c |
1 | #!./perl |
2 | # |
3 | # Tests for perl exit codes, playing with $?, etc... |
4 | |
5 | |
6 | BEGIN { |
7 | chdir 't' if -d 't'; |
69026470 |
8 | @INC = qw(. ../lib); |
14cf881c |
9 | } |
10 | |
ee2f883e |
11 | # VMS and Windows need -e "...", most everything else works better with ' |
12 | my $quote = $^O =~ /^(VMS|MSWin\d+)$/ ? q{"} : q{'}; |
14cf881c |
13 | |
14 | # Run some code, return its wait status. |
15 | sub run { |
16 | my($code) = shift; |
17 | my $cmd = "$^X -e "; |
18 | return system($cmd.$quote.$code.$quote); |
19 | } |
20 | |
0ab78052 |
21 | BEGIN { |
dc459aad |
22 | # MacOS system() doesn't have good return value |
23 | $numtests = ($^O eq 'VMS') ? 7 : ($^O eq 'MacOS') ? 0 : 3; |
0ab78052 |
24 | } |
14cf881c |
25 | |
69026470 |
26 | require "test.pl"; |
27 | plan(tests => $numtests); |
55a9fe1d |
28 | |
dc459aad |
29 | if ($^O ne 'MacOS') { |
55a9fe1d |
30 | my $exit, $exit_arg; |
14cf881c |
31 | |
32 | $exit = run('exit'); |
33 | is( $exit >> 8, 0, 'Normal exit' ); |
34 | |
55a9fe1d |
35 | if ($^O ne 'VMS') { |
36 | |
37 | $exit = run('exit 42'); |
38 | is( $exit >> 8, 42, 'Non-zero exit' ); |
39 | |
40 | } else { |
41 | |
42 | # On VMS, successful returns from system() are always 0, warnings are 1, |
43 | # errors are 2, and fatal errors are 4. |
44 | |
45 | $exit = run("exit 196609"); # %CLI-S-NORMAL |
46 | is( $exit >> 8, 0, 'success exit' ); |
47 | |
48 | $exit = run("exit 196611"); # %CLI-I-NORMAL |
49 | is( $exit >> 8, 0, 'informational exit' ); |
50 | |
51 | $exit = run("exit 196608"); # %CLI-W-NORMAL |
52 | is( $exit >> 8, 1, 'warning exit' ); |
53 | |
54 | $exit = run("exit 196610"); # %CLI-E-NORMAL |
55 | is( $exit >> 8, 2, 'error exit' ); |
56 | |
57 | $exit = run("exit 196612"); # %CLI-F-NORMAL |
58 | is( $exit >> 8, 4, 'fatal error exit' ); |
59 | } |
14cf881c |
60 | |
412a0271 |
61 | $exit_arg = 42; |
62 | $exit = run("END { \$? = $exit_arg }"); |
63 | |
64 | # On VMS, in the child process the actual exit status will be SS$_ABORT, |
65 | # which is what you get from any non-zero value of $? that has been |
66 | # dePOSIXified by STATUS_POSIX_SET. In the parent process, all we'll |
67 | # see are the severity bits (0-2) shifted left by 8. |
68 | $exit_arg = (44 & 7) if $^O eq 'VMS'; |
69 | |
70 | is( $exit >> 8, $exit_arg, 'Changing $? in END block' ); |
dc459aad |
71 | } |