| 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 | |
| 11 | # VMS and Windows need -e "...", most everything else works better with ' |
| 12 | my $quote = $^O =~ /^(VMS|MSWin\d+)$/ ? q{"} : q{'}; |
| 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 | |
| 21 | BEGIN { |
| 22 | $numtests = ($^O eq 'VMS') ? 7 : 3; |
| 23 | } |
| 24 | |
| 25 | use Test::More tests => $numtests; |
| 26 | |
| 27 | my $exit, $exit_arg; |
| 28 | |
| 29 | $exit = run('exit'); |
| 30 | is( $exit >> 8, 0, 'Normal exit' ); |
| 31 | |
| 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 | } |
| 57 | |
| 58 | $exit = run('END { $? = 42 }'); |
| 59 | is( $exit >> 8, 42, 'Changing $? in END block' ); |