1N/A#!/usr/bin/perl -w
1N/A
1N/A# Can't use Test.pm, that's a 5.005 thing.
1N/Apackage My::Test;
1N/A
1N/ABEGIN {
1N/A if( $ENV{PERL_CORE} ) {
1N/A chdir 't';
1N/A @INC = '../lib';
1N/A }
1N/A}
1N/A
1N/Aunless( eval { require File::Spec } ) {
1N/A print "1..0 # Skip Need File::Spec to run this test\n";
1N/A exit 0;
1N/A}
1N/A
1N/Aif( $^O eq 'VMS' && $] <= 5.00503 ) {
1N/A print "1..0 # Skip test will hang on older VMS perls\n";
1N/A exit 0;
1N/A}
1N/A
1N/Aif( $^O eq 'MacOS' ) {
1N/A print "1..0 # Skip exit status broken on Mac OS\n";
1N/A exit 0;
1N/A}
1N/A
1N/Amy $test_num = 1;
1N/A# Utility testing functions.
1N/Asub ok ($;$) {
1N/A my($test, $name) = @_;
1N/A my $ok = '';
1N/A $ok .= "not " unless $test;
1N/A $ok .= "ok $test_num";
1N/A $ok .= " - $name" if defined $name;
1N/A $ok .= "\n";
1N/A print $ok;
1N/A $test_num++;
1N/A}
1N/A
1N/A
1N/Apackage main;
1N/A
1N/Amy $IsVMS = $^O eq 'VMS';
1N/A
1N/Aprint "# Ahh! I see you're running VMS.\n" if $IsVMS;
1N/A
1N/Amy %Tests = (
1N/A # Everyone Else VMS
1N/A 'success.plx' => [0, 0],
1N/A 'one_fail.plx' => [1, 4],
1N/A 'two_fail.plx' => [2, 4],
1N/A 'five_fail.plx' => [5, 4],
1N/A 'extras.plx' => [3, 4],
1N/A 'too_few.plx' => [4, 4],
1N/A 'death.plx' => [255, 4],
1N/A 'last_minute_death.plx' => [255, 4],
1N/A 'pre_plan_death.plx' => ['not zero', 'not zero'],
1N/A 'death_in_eval.plx' => [0, 0],
1N/A 'require.plx' => [0, 0],
1N/A );
1N/A
1N/Aprint "1..".keys(%Tests)."\n";
1N/A
1N/Aeval { require POSIX; &POSIX::WEXITSTATUS(0) };
1N/Aif( $@ ) {
1N/A *exitstatus = sub { $_[0] >> 8 };
1N/A}
1N/Aelse {
1N/A *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
1N/A}
1N/A
1N/Achdir 't';
1N/Amy $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
1N/Awhile( my($test_name, $exit_codes) = each %Tests ) {
1N/A my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0];
1N/A
1N/A my $Perl = $^X;
1N/A
1N/A if( $^O eq 'VMS' ) {
1N/A # VMS can't use its own $^X in a system call until almost 5.8
1N/A $Perl = "MCR $^X" if $] < 5.007003;
1N/A
1N/A # Quiet noisy 'SYS$ABORT'. 'hushed' only exists in 5.6 and up,
1N/A # but it doesn't do any harm on eariler perls.
1N/A $Perl .= q{ -"Mvmsish=hushed"};
1N/A }
1N/A
1N/A my $file = File::Spec->catfile($lib, $test_name);
1N/A my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
1N/A my $actual_exit = exitstatus($wait_stat);
1N/A
1N/A if( $exit_code eq 'not zero' ) {
1N/A My::Test::ok( $actual_exit != 0,
1N/A "$test_name exited with $actual_exit ".
1N/A "(expected $exit_code)");
1N/A }
1N/A else {
1N/A My::Test::ok( $actual_exit == $exit_code,
1N/A "$test_name exited with $actual_exit ".
1N/A "(expected $exit_code)");
1N/A }
1N/A}