Commit | Line | Data |
60ffb308 |
1 | #!/usr/bin/perl -w |
2 | |
4dd974da |
3 | # Can't use Test.pm, that's a 5.005 thing. |
4 | package My::Test; |
5 | |
a9153838 |
6 | BEGIN { |
7 | if( $ENV{PERL_CORE} ) { |
8 | chdir 't'; |
9 | @INC = '../lib'; |
10 | } |
11 | } |
12 | |
04955c14 |
13 | require Test::Builder; |
14 | my $TB = Test::Builder->create(); |
15 | $TB->level(0); |
4dd974da |
16 | |
17 | |
18 | package main; |
19 | |
3e887aae |
20 | use Cwd; |
21 | use File::Spec; |
d020a79a |
22 | |
3e887aae |
23 | my $Orig_Dir = cwd; |
d020a79a |
24 | |
3e887aae |
25 | my $Perl = File::Spec->rel2abs($^X); |
26 | if( $^O eq 'VMS' ) { |
27 | # VMS can't use its own $^X in a system call until almost 5.8 |
28 | $Perl = "MCR $^X" if $] < 5.007003; |
29 | |
30 | # Quiet noisy 'SYS$ABORT' |
80be9731 |
31 | $Perl .= q{ -"I../lib"} if $ENV{PERL_CORE}; |
3e887aae |
32 | $Perl .= q{ -"Mvmsish=hushed"}; |
33 | } |
4dd974da |
34 | |
4dd974da |
35 | |
89c1e84a |
36 | eval { require POSIX; &POSIX::WEXITSTATUS(0) }; |
37 | if( $@ ) { |
38 | *exitstatus = sub { $_[0] >> 8 }; |
39 | } |
40 | else { |
41 | *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) } |
42 | } |
43 | |
ccbd73a4 |
44 | |
3e887aae |
45 | # Some OS' will alter the exit code to their own native sense... |
46 | # sometimes. Rather than deal with the exception we'll just |
47 | # build up the mapping. |
48 | print "# Building up a map of exit codes. May take a while.\n"; |
49 | my %Exit_Map; |
50 | |
51 | open my $fh, ">", "exit_map_test" or die $!; |
52 | print $fh <<'DONE'; |
53 | if ($^O eq 'VMS') { |
54 | require vmsish; |
55 | import vmsish qw(hushed); |
56 | } |
57 | my $exit = shift; |
58 | print "exit $exit\n"; |
59 | END { $? = $exit }; |
60 | DONE |
61 | |
62 | close $fh; |
63 | END { 1 while unlink "exit_map_test" } |
64 | |
65 | for my $exit (0..255) { |
66 | # This correctly emulates Test::Builder's behavior. |
67 | my $out = qx[$Perl exit_map_test $exit]; |
68 | $TB->like( $out, qr/^exit $exit\n/, "exit map test for $exit" ); |
69 | $Exit_Map{$exit} = exitstatus($?); |
70 | } |
71 | print "# Done.\n"; |
12b8e1e4 |
72 | |
a9153838 |
73 | |
3e887aae |
74 | my %Tests = ( |
75 | # File Exit Code |
76 | 'success.plx' => 0, |
77 | 'one_fail.plx' => 1, |
78 | 'two_fail.plx' => 2, |
79 | 'five_fail.plx' => 5, |
80 | 'extras.plx' => 2, |
81 | 'too_few.plx' => 255, |
82 | 'too_few_fail.plx' => 2, |
83 | 'death.plx' => 255, |
84 | 'last_minute_death.plx' => 255, |
85 | 'pre_plan_death.plx' => 'not zero', |
86 | 'death_in_eval.plx' => 0, |
87 | 'require.plx' => 0, |
88 | 'death_with_handler.plx' => 255, |
89 | 'exit.plx' => 1, |
90 | ); |
a9153838 |
91 | |
3e887aae |
92 | chdir 't'; |
93 | my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); |
94 | while( my($test_name, $exit_code) = each %Tests ) { |
15db8fc4 |
95 | my $file = File::Spec->catfile($lib, $test_name); |
a9153838 |
96 | my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); |
89c1e84a |
97 | my $actual_exit = exitstatus($wait_stat); |
12b8e1e4 |
98 | |
60ffb308 |
99 | if( $exit_code eq 'not zero' ) { |
3e887aae |
100 | $TB->isnt_num( $actual_exit, $Exit_Map{0}, |
60ffb308 |
101 | "$test_name exited with $actual_exit ". |
3e887aae |
102 | "(expected non-zero)"); |
60ffb308 |
103 | } |
104 | else { |
3e887aae |
105 | $TB->is_num( $actual_exit, $Exit_Map{$exit_code}, |
60ffb308 |
106 | "$test_name exited with $actual_exit ". |
3e887aae |
107 | "(expected $Exit_Map{$exit_code})"); |
60ffb308 |
108 | } |
d020a79a |
109 | } |
3e887aae |
110 | |
111 | $TB->done_testing( scalar keys(%Tests) + 256 ); |
112 | |
113 | # So any END block file cleanup works. |
114 | chdir $Orig_Dir; |