t/lib/test-harness.t

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