sync a bunch of files with Test::Simple 0.86
[perl.git] / lib / Test / Simple / t / exit.t
1 #!/usr/bin/perl -w
2 # $Id$
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 }