lib/Test/Harness.t

   1 #!perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use strict;
   9
  10 # For shutting up Test::Harness.
  11 package My::Dev::Null;
  12 use Tie::Handle;
  13 @My::Dev::Null::ISA = qw(Tie::StdHandle);
  14
  15 sub WRITE { }
  16
  17
  18 package main;
  19
  20 # Utility testing functions.
  21 my $test_num = 1;
  22 sub ok ($;$) {
  23     my($test, $name) = @_;
  24     my $okstring = '';
  25     $okstring = "not " unless $test;
  26     $okstring .= "ok $test_num";
  27     $okstring .= " - $name" if defined $name;
  28     print "$okstring\n";
  29     $test_num++;
  30 }
  31
  32 sub eqhash {
  33     my($a1, $a2) = @_;
  34     return 0 unless keys %$a1 == keys %$a2;
  35
  36     my $ok = 1;
  37     foreach my $k (keys %$a1) {
  38         $ok = $a1->{$k} eq $a2->{$k};
  39         last unless $ok;
  40     }
  41
  42     return $ok;
  43 }
  44
  45 use vars qw($Total_tests %samples);
  46
  47 my $loaded;
  48 BEGIN { $| = 1; $^W = 1; }
  49 END {print "not ok $test_num\n" unless $loaded;}
  50 print "1..$Total_tests\n";
  51 use Test::Harness;
  52 $loaded = 1;
  53 ok(1, 'compile');
  54 ######################### End of black magic.
  55
  56 BEGIN {
  57     %samples = (
  58                 simple            => {
  59                                       bonus      => 0,
  60                                       max        => 5,
  61                                       'ok'         => 5,
  62                                       files      => 1,
  63                                       bad        => 0,
  64                                       good       => 1,
  65                                       tests      => 1,
  66                                       sub_skipped=> 0,
  67                                       skipped    => 0,
  68                                      },
  69                 simple_fail      => {
  70                                      bonus       => 0,
  71                                      max         => 5,
  72                                      'ok'          => 3,
  73                                      files       => 1,
  74                                      bad         => 1,
  75                                      good        => 0,
  76                                      tests       => 1,
  77                                      sub_skipped => 0,
  78                                      skipped     => 0,
  79                                     },
  80                 descriptive       => {
  81                                       bonus      => 0,
  82                                       max        => 5,
  83                                       'ok'         => 5,
  84                                       files      => 1,
  85                                       bad        => 0,
  86                                       good       => 1,
  87                                       tests      => 1,
  88                                       sub_skipped=> 0,
  89                                       skipped    => 0,
  90                                      },
  91                 no_nums           => {
  92                                       bonus      => 0,
  93                                       max        => 5,
  94                                       'ok'         => 4,
  95                                       files      => 1,
  96                                       bad        => 1,
  97                                       good       => 0,
  98                                       tests      => 1,
  99                                       sub_skipped=> 0,
 100                                       skipped    => 0,
 101                                      },
 102                 todo              => {
 103                                       bonus      => 1,
 104                                       max        => 5,
 105                                       'ok'         => 5,
 106                                       files      => 1,
 107                                       bad        => 0,
 108                                       good       => 1,
 109                                       tests      => 1,
 110                                       sub_skipped=> 0,
 111                                       skipped    => 0,
 112                                      },
 113                 skip              => {
 114                                       bonus      => 0,
 115                                       max        => 5,
 116                                       'ok'         => 5,
 117                                       files      => 1,
 118                                       bad        => 0,
 119                                       good       => 1,
 120                                       tests      => 1,
 121                                       sub_skipped=> 1,
 122                                       skipped    => 0,
 123                                      },
 124                 bailout           => 0,
 125                 combined          => {
 126                                       bonus      => 1,
 127                                       max        => 10,
 128                                       'ok'         => 8,
 129                                       files      => 1,
 130                                       bad        => 1,
 131                                       good       => 0,
 132                                       tests      => 1,
 133                                       sub_skipped=> 1,
 134                                       skipped    => 0
 135                                      },
 136                 duplicates        => {
 137                                       bonus      => 0,
 138                                       max        => 10,
 139                                       'ok'         => 11,
 140                                       files      => 1,
 141                                       bad        => 1,
 142                                       good       => 0,
 143                                       tests      => 1,
 144                                       sub_skipped=> 0,
 145                                       skipped    => 0,
 146                                      },
 147                 header_at_end     => {
 148                                       bonus      => 0,
 149                                       max        => 4,
 150                                       'ok'         => 4,
 151                                       files      => 1,
 152                                       bad        => 0,
 153                                       good       => 1,
 154                                       tests      => 1,
 155                                       sub_skipped=> 0,
 156                                       skipped    => 0,
 157                                      },
 158                 skip_all          => {
 159                                       bonus      => 0,
 160                                       max        => 0,
 161                                       'ok'         => 0,
 162                                       files      => 1,
 163                                       bad        => 0,
 164                                       good       => 1,
 165                                       tests      => 1,
 166                                       sub_skipped=> 0,
 167                                       skipped    => 1,
 168                                      },
 169                 with_comments     => {
 170                                       bonus      => 2,
 171                                       max        => 5,
 172                                       'ok'         => 5,
 173                                       files      => 1,
 174                                       bad        => 0,
 175                                       good       => 1,
 176                                       tests      => 1,
 177                                       sub_skipped=> 0,
 178                                       skipped    => 0,
 179                                      },
 180                );
 181
 182     $Total_tests = keys(%samples) + 1;
 183 }
 184
 185 tie *NULL, 'My::Dev::Null' or die $!;
 186
 187 while (my($test, $expect) = each %samples) {
 188     # _run_all_tests() runs the tests but skips the formatting.
 189     my($totals, $failed);
 190     eval {
 191         select NULL;    # _run_all_tests() isn't as quiet as it should be.
 192         ($totals, $failed) =
 193           Test::Harness::_run_all_tests("lib/sample-tests/$test");
 194     };
 195     select STDOUT;
 196
 197     unless( $@ ) {
 198         ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ),
 199                                                                       $test );
 200     }
 201     else {      # special case for bailout
 202         ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
 203             $test );
 204     }
 205 }