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