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'               => [2,      4],
55             'too_few.plx'              => [255,    4],
56             'too_few_fail.plx'         => [2,      4],
57             'death.plx'                => [255,    4],
58             'last_minute_death.plx'    => [255,    4],
59             'pre_plan_death.plx'       => ['not zero',    'not zero'],
60             'death_in_eval.plx'        => [0,      0],
61             'require.plx'              => [0,      0],
62	     'exit.plx'                 => [1,      4],
63            );
64
65print "1..".keys(%Tests)."\n";
66
67eval { require POSIX; &POSIX::WEXITSTATUS(0) };
68if( $@ ) {
69    *exitstatus = sub { $_[0] >> 8 };
70}
71else {
72    *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
73}
74
75chdir 't';
76my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
77while( my($test_name, $exit_codes) = each %Tests ) {
78    my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0];
79
80    my $Perl = $^X;
81
82    if( $^O eq 'VMS' ) {
83        # VMS can't use its own $^X in a system call until almost 5.8
84        $Perl = "MCR $^X" if $] < 5.007003;
85
86        # Quiet noisy 'SYS$ABORT'.  'hushed' only exists in 5.6 and up,
87        # but it doesn't do any harm on eariler perls.
88        $Perl .= q{ -"Mvmsish=hushed"};
89    }
90
91    my $file = File::Spec->catfile($lib, $test_name);
92    my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
93    my $actual_exit = exitstatus($wait_stat);
94
95    if( $exit_code eq 'not zero' ) {
96        My::Test::ok( $actual_exit != 0,
97                      "$test_name exited with $actual_exit ".
98                      "(expected $exit_code)");
99    }
100    else {
101        My::Test::ok( $actual_exit == $exit_code,
102                      "$test_name exited with $actual_exit ".
103                      "(expected $exit_code)");
104    }
105}
106