This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[ANNOUNCE] Test::Simple 0.47
[perl5.git] / lib / Test / Simple / t / exit.t
1 #!/usr/bin/perl -w
2
3 # Can't use Test.pm, that's a 5.005 thing.
4 package My::Test;
5
6 BEGIN {
7     if( $ENV{PERL_CORE} ) {
8         chdir 't';
9         @INC = '../lib';
10     }
11 }
12
13 unless( eval { require File::Spec } ) {
14     print "1..0 # Skip Need File::Spec to run this test\n";
15     exit 0;
16 }
17
18 if( $^O eq 'VMS' && $] <= 5.00503 ) {
19     print "1..0 # Skip test will hang on older VMS perls\n";
20     exit 0;
21 }
22
23 if( $^O eq 'MacOS' ) {
24     print "1..0 # Skip exit status broken on Mac OS\n";
25     exit 0;
26 }
27
28 my $test_num = 1;
29 # Utility testing functions.
30 sub 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
42 package main;
43
44 my $IsVMS = $^O eq 'VMS';
45
46 print "# Ahh!  I see you're running VMS.\n" if $IsVMS;
47
48 my %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
63 print "1..".keys(%Tests)."\n";
64
65 eval { require POSIX; &POSIX::WEXITSTATUS(0) };
66 if( $@ ) {
67     *exitstatus = sub { $_[0] >> 8 };
68 }
69 else {
70     *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
71 }
72
73 chdir 't';
74 my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
75 while( 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 }