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