cpan/Test-Simple/t/exit.t

   1 #!/usr/bin/perl -w
   2
   3 # Can't use Test.pm, that's a 5.005 thing.
   4 package My::Test;
   5
   6 BEGIN {
   7     if( $ENV{PERL_CORE} ) {
   8         chdir 't';
   9         @INC = '../lib';
  10     }
  11 }
  12
  13 require Test::Builder;
  14 my $TB = Test::Builder->create();
  15 $TB->level(0);
  16
  17
  18 package main;
  19
  20 use Cwd;
  21 use File::Spec;
  22
  23 my $Orig_Dir = cwd;
  24
  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'
  31     $Perl .= q{ -"I../lib"} if $ENV{PERL_CORE};
  32     $Perl .= q{ -"Mvmsish=hushed"};
  33 }
  34
  35
  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
  44
  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";
  72
  73
  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              'one_fail_without_plan.plx'    => 1,
  91              'missing_done_testing.plx'     => 254,
  92             );
  93
  94 chdir 't';
  95 my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
  96 while( my($test_name, $exit_code) = each %Tests ) {
  97     my $file = File::Spec->catfile($lib, $test_name);
  98     my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
  99     my $actual_exit = exitstatus($wait_stat);
 100
 101     if( $exit_code eq 'not zero' ) {
 102         $TB->isnt_num( $actual_exit, $Exit_Map{0},
 103                       "$test_name exited with $actual_exit ".
 104                       "(expected non-zero)");
 105     }
 106     else {
 107         $TB->is_num( $actual_exit, $Exit_Map{$exit_code},
 108                       "$test_name exited with $actual_exit ".
 109                       "(expected $Exit_Map{$exit_code})");
 110     }
 111 }
 112
 113 $TB->done_testing( scalar keys(%Tests) + 256 );
 114
 115 # So any END block file cleanup works.
 116 chdir $Orig_Dir;