This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Be sure to find the vmsish pragma for one-liners in exit.t.
[perl5.git] / lib / Test / Simple / t / exit.t
CommitLineData
60ffb308
MS
1#!/usr/bin/perl -w
2
4dd974da
JH
3# Can't use Test.pm, that's a 5.005 thing.
4package My::Test;
5
a9153838
MS
6BEGIN {
7 if( $ENV{PERL_CORE} ) {
8 chdir 't';
9 @INC = '../lib';
10 }
11}
12
04955c14
SP
13require Test::Builder;
14my $TB = Test::Builder->create();
15$TB->level(0);
4dd974da
JH
16
17
18package main;
19
3e887aae
DM
20use Cwd;
21use File::Spec;
d020a79a 22
3e887aae 23my $Orig_Dir = cwd;
d020a79a 24
3e887aae
DM
25my $Perl = File::Spec->rel2abs($^X);
26if( $^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
DM
32 $Perl .= q{ -"Mvmsish=hushed"};
33}
4dd974da 34
4dd974da 35
89c1e84a
MS
36eval { require POSIX; &POSIX::WEXITSTATUS(0) };
37if( $@ ) {
38 *exitstatus = sub { $_[0] >> 8 };
39}
40else {
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.
48print "# Building up a map of exit codes. May take a while.\n";
49my %Exit_Map;
50
51open my $fh, ">", "exit_map_test" or die $!;
52print $fh <<'DONE';
53if ($^O eq 'VMS') {
54 require vmsish;
55 import vmsish qw(hushed);
56}
57my $exit = shift;
58print "exit $exit\n";
59END { $? = $exit };
60DONE
61
62close $fh;
63END { 1 while unlink "exit_map_test" }
64
65for 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}
71print "# Done.\n";
12b8e1e4 72
a9153838 73
3e887aae
DM
74my %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
DM
92chdir 't';
93my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
94while( 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
MS
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
DM
110
111$TB->done_testing( scalar keys(%Tests) + 256 );
112
113# So any END block file cleanup works.
114chdir $Orig_Dir;