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