Upgrade to Test-Simple-0.82.

[p5sagit/p5-mst-13.2.git] / lib / Test / Simple / t / exit.t

#!/usr/bin/perl -w
# $Id: /mirror/googlecode/test-more/t/exit.t 57943 2008-08-18T02:09:22.275428Z brooklyn.kid51  $

# Can't use Test.pm, that's a 5.005 thing.
package My::Test;

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = '../lib';
    }
}

unless( eval { require File::Spec } ) {
    print "1..0 # Skip Need File::Spec to run this test\n";
    exit 0;
}

if( $^O eq 'VMS' && $] <= 5.00503 ) {
    print "1..0 # Skip test will hang on older VMS perls\n";
    exit 0;
}

if( $^O eq 'MacOS' ) {
    print "1..0 # Skip exit status broken on Mac OS\n";
    exit 0;
}

require Test::Builder;
my $TB = Test::Builder->create();
$TB->level(0);


package main;

my $IsVMS = $^O eq 'VMS';

print "# Ahh!  I see you're running VMS.\n" if $IsVMS;

my %Tests = (
             #                      Everyone Else   VMS
             'success.plx'              => [0,      0],
             'one_fail.plx'             => [1,      4],
             'two_fail.plx'             => [2,      4],
             'five_fail.plx'            => [5,      4],
             'extras.plx'               => [2,      4],
             'too_few.plx'              => [255,    4],
             'too_few_fail.plx'         => [2,      4],
             'death.plx'                => [255,    4],
             'last_minute_death.plx'    => [255,    4],
             'pre_plan_death.plx'       => ['not zero',    'not zero'],
             'death_in_eval.plx'        => [0,      0],
             'require.plx'              => [0,      0],
             'death_with_handler.plx'   => [255,    4],
             'exit.plx'                 => [1,      4],
            );

$TB->plan( tests => scalar keys(%Tests) );

eval { require POSIX; &POSIX::WEXITSTATUS(0) };
if( $@ ) {
    *exitstatus = sub { $_[0] >> 8 };
}
else {
    *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
}

my $Perl = File::Spec->rel2abs($^X);

chdir 't';
my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
while( my($test_name, $exit_codes) = each %Tests ) {
    my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0];

    if( $^O eq 'VMS' ) {
        # VMS can't use its own $^X in a system call until almost 5.8
        $Perl = "MCR $^X" if $] < 5.007003;

        # Quiet noisy 'SYS$ABORT'.  'hushed' only exists in 5.6 and up,
        # but it doesn't do any harm on eariler perls.
        $Perl .= q{ -"Mvmsish=hushed"};
    }

    my $file = File::Spec->catfile($lib, $test_name);
    my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
    my $actual_exit = exitstatus($wait_stat);

    if( $exit_code eq 'not zero' ) {
        $TB->isnt_num( $actual_exit, 0,
                      "$test_name exited with $actual_exit ".
                      "(expected $exit_code)");
    }
    else {
        $TB->is_num( $actual_exit, $exit_code, 
                      "$test_name exited with $actual_exit ".
                      "(expected $exit_code)");
    }
}