lib/Test/Simple/t/exit.t

   1 #!/usr/bin/perl -w
   2 # $Id: /mirror/googlecode/test-more/t/exit.t 57943 2008-08-18T02:09:22.275428Z brooklyn.kid51  $
   3
   4 # Can't use Test.pm, that's a 5.005 thing.
   5 package My::Test;
   6
   7 BEGIN {
   8     if( $ENV{PERL_CORE} ) {
   9         chdir 't';
  10         @INC = '../lib';
  11     }
  12 }
  13
  14 unless( eval { require File::Spec } ) {
  15     print "1..0 # Skip Need File::Spec to run this test\n";
  16     exit 0;
  17 }
  18
  19 if( $^O eq 'VMS' && $] <= 5.00503 ) {
  20     print "1..0 # Skip test will hang on older VMS perls\n";
  21     exit 0;
  22 }
  23
  24 if( $^O eq 'MacOS' ) {
  25     print "1..0 # Skip exit status broken on Mac OS\n";
  26     exit 0;
  27 }
  28
  29 require Test::Builder;
  30 my $TB = Test::Builder->create();
  31 $TB->level(0);
  32
  33
  34 package main;
  35
  36 my $IsVMS = $^O eq 'VMS';
  37
  38 print "# Ahh!  I see you're running VMS.\n" if $IsVMS;
  39
  40 my %Tests = (
  41              #                      Everyone Else   VMS
  42              'success.plx'              => [0,      0],
  43              'one_fail.plx'             => [1,      4],
  44              'two_fail.plx'             => [2,      4],
  45              'five_fail.plx'            => [5,      4],
  46              'extras.plx'               => [2,      4],
  47              'too_few.plx'              => [255,    4],
  48              'too_few_fail.plx'         => [2,      4],
  49              'death.plx'                => [255,    4],
  50              'last_minute_death.plx'    => [255,    4],
  51              'pre_plan_death.plx'       => ['not zero',    'not zero'],
  52              'death_in_eval.plx'        => [0,      0],
  53              'require.plx'              => [0,      0],
  54              'death_with_handler.plx'   => [255,    4],
  55              'exit.plx'                 => [1,      4],
  56             );
  57
  58 $TB->plan( tests => scalar keys(%Tests) );
  59
  60 eval { require POSIX; &POSIX::WEXITSTATUS(0) };
  61 if( $@ ) {
  62     *exitstatus = sub { $_[0] >> 8 };
  63 }
  64 else {
  65     *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
  66 }
  67
  68 my $Perl = File::Spec->rel2abs($^X);
  69
  70 chdir 't';
  71 my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
  72 while( my($test_name, $exit_codes) = each %Tests ) {
  73     my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0];
  74
  75     if( $^O eq 'VMS' ) {
  76         # VMS can't use its own $^X in a system call until almost 5.8
  77         $Perl = "MCR $^X" if $] < 5.007003;
  78
  79         # Quiet noisy 'SYS$ABORT'.  'hushed' only exists in 5.6 and up,
  80         # but it doesn't do any harm on eariler perls.
  81         $Perl .= q{ -"Mvmsish=hushed"};
  82     }
  83
  84     my $file = File::Spec->catfile($lib, $test_name);
  85     my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
  86     my $actual_exit = exitstatus($wait_stat);
  87
  88     if( $exit_code eq 'not zero' ) {
  89         $TB->isnt_num( $actual_exit, 0,
  90                       "$test_name exited with $actual_exit ".
  91                       "(expected $exit_code)");
  92     }
  93     else {
  94         $TB->is_num( $actual_exit, $exit_code,
  95                       "$test_name exited with $actual_exit ".
  96                       "(expected $exit_code)");
  97     }
  98 }