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'; |
8 | @INC = '../lib'; |
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 { |
22 | $numtests = ($^O eq 'VMS') ? 7 : 3; |
23 | } |
14cf881c |
24 | |
0ab78052 |
25 | use Test::More tests => $numtests; |
55a9fe1d |
26 | |
27 | my $exit, $exit_arg; |
14cf881c |
28 | |
29 | $exit = run('exit'); |
30 | is( $exit >> 8, 0, 'Normal exit' ); |
31 | |
55a9fe1d |
32 | if ($^O ne 'VMS') { |
33 | |
34 | $exit = run('exit 42'); |
35 | is( $exit >> 8, 42, 'Non-zero exit' ); |
36 | |
37 | } else { |
38 | |
39 | # On VMS, successful returns from system() are always 0, warnings are 1, |
40 | # errors are 2, and fatal errors are 4. |
41 | |
42 | $exit = run("exit 196609"); # %CLI-S-NORMAL |
43 | is( $exit >> 8, 0, 'success exit' ); |
44 | |
45 | $exit = run("exit 196611"); # %CLI-I-NORMAL |
46 | is( $exit >> 8, 0, 'informational exit' ); |
47 | |
48 | $exit = run("exit 196608"); # %CLI-W-NORMAL |
49 | is( $exit >> 8, 1, 'warning exit' ); |
50 | |
51 | $exit = run("exit 196610"); # %CLI-E-NORMAL |
52 | is( $exit >> 8, 2, 'error exit' ); |
53 | |
54 | $exit = run("exit 196612"); # %CLI-F-NORMAL |
55 | is( $exit >> 8, 4, 'fatal error exit' ); |
56 | } |
14cf881c |
57 | |
412a0271 |
58 | $exit_arg = 42; |
59 | $exit = run("END { \$? = $exit_arg }"); |
60 | |
61 | # On VMS, in the child process the actual exit status will be SS$_ABORT, |
62 | # which is what you get from any non-zero value of $? that has been |
63 | # dePOSIXified by STATUS_POSIX_SET. In the parent process, all we'll |
64 | # see are the severity bits (0-2) shifted left by 8. |
65 | $exit_arg = (44 & 7) if $^O eq 'VMS'; |
66 | |
67 | is( $exit >> 8, $exit_arg, 'Changing $? in END block' ); |