Commit | Line | Data |
---|---|---|
60ffb308 MS |
1 | #!/usr/bin/perl -w |
2 | ||
4dd974da JH |
3 | # Can't use Test.pm, that's a 5.005 thing. |
4 | package My::Test; | |
5 | ||
a9153838 MS |
6 | BEGIN { |
7 | if( $ENV{PERL_CORE} ) { | |
8 | chdir 't'; | |
9 | @INC = '../lib'; | |
10 | } | |
11 | } | |
12 | ||
04955c14 SP |
13 | require Test::Builder; |
14 | my $TB = Test::Builder->create(); | |
15 | $TB->level(0); | |
4dd974da JH |
16 | |
17 | ||
18 | package main; | |
19 | ||
3e887aae DM |
20 | use Cwd; |
21 | use File::Spec; | |
d020a79a | 22 | |
3e887aae | 23 | my $Orig_Dir = cwd; |
d020a79a | 24 | |
3e887aae DM |
25 | my $Perl = File::Spec->rel2abs($^X); |
26 | if( $^O eq 'VMS' ) { | |
3709f1d4 CBW |
27 | # VMS can't use its own $^X in a system call until almost 5.8 |
28 | $Perl = "MCR $^X" if $] < 5.007003; | |
29 | ||
3e887aae | 30 | # Quiet noisy 'SYS$ABORT' |
80be9731 | 31 | $Perl .= q{ -"I../lib"} if $ENV{PERL_CORE}; |
3e887aae DM |
32 | $Perl .= q{ -"Mvmsish=hushed"}; |
33 | } | |
4dd974da | 34 | |
4dd974da | 35 | |
89c1e84a MS |
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 DM |
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. | |
3709f1d4 | 67 | my $out = qx[$Perl exit_map_test $exit]; |
3e887aae DM |
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 DM |
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, | |
411e93ce SH |
90 | 'one_fail_without_plan.plx' => 1, |
91 | 'missing_done_testing.plx' => 254, | |
3e887aae | 92 | ); |
a9153838 | 93 | |
3e887aae DM |
94 | chdir 't'; |
95 | my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); | |
96 | while( my($test_name, $exit_code) = each %Tests ) { | |
15db8fc4 | 97 | my $file = File::Spec->catfile($lib, $test_name); |
3709f1d4 | 98 | my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); |
89c1e84a | 99 | my $actual_exit = exitstatus($wait_stat); |
12b8e1e4 | 100 | |
60ffb308 | 101 | if( $exit_code eq 'not zero' ) { |
3e887aae | 102 | $TB->isnt_num( $actual_exit, $Exit_Map{0}, |
60ffb308 | 103 | "$test_name exited with $actual_exit ". |
3e887aae | 104 | "(expected non-zero)"); |
60ffb308 MS |
105 | } |
106 | else { | |
3709f1d4 | 107 | $TB->is_num( $actual_exit, $Exit_Map{$exit_code}, |
60ffb308 | 108 | "$test_name exited with $actual_exit ". |
3e887aae | 109 | "(expected $Exit_Map{$exit_code})"); |
60ffb308 | 110 | } |
d020a79a | 111 | } |
3e887aae DM |
112 | |
113 | $TB->done_testing( scalar keys(%Tests) + 256 ); | |
114 | ||
115 | # So any END block file cleanup works. | |
116 | chdir $Orig_Dir; |