lib/Test/Simple/t/exit.t

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