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