#!./perl BEGIN { chdir 't' if -d 't'; @INC = '../lib'; } # For shutting up Test::Harness. package My::Dev::Null; use Tie::Handle; @ISA = qw(Tie::StdHandle); sub WRITE { } package main; # Utility testing functions. my $test_num = 1; sub ok ($;$) { my($test, $name) = @_; my $okstring = ''; $okstring = "not " unless $test; $okstring .= "ok $test_num"; $okstring .= " - $name" if defined $name; print "$okstring\n"; $test_num++; } sub eqhash { my($a1, $a2) = @_; return 0 unless keys %$a1 == keys %$a2; my $ok = 1; foreach my $k (keys %$a1) { $ok = $a1->{$k} eq $a2->{$k}; last unless $ok; } return $ok; } my $loaded; BEGIN { $| = 1; $^W = 1; } END {print "not ok $test_num\n" unless $loaded;} print "1..$Total_tests\n"; use Test::Harness; $loaded = 1; ok(1, 'compile'); ######################### End of black magic. BEGIN { %samples = ( simple => { bonus => 0, max => 5, ok => 5, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 0, skipped => 0, }, simple_fail => { bonus => 0, max => 5, ok => 3, files => 1, bad => 1, good => 0, tests => 1, sub_skipped => 0, skipped => 0, }, descriptive => { bonus => 0, max => 5, ok => 5, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 0, skipped => 0, }, no_nums => { bonus => 0, max => 5, ok => 4, files => 1, bad => 1, good => 0, tests => 1, sub_skipped=> 0, skipped => 0, }, todo => { bonus => 1, max => 5, ok => 5, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 0, skipped => 0, }, skip => { bonus => 0, max => 5, ok => 5, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 1, skipped => 0, }, bailout => 0, combined => { bonus => 1, max => 10, ok => 8, files => 1, bad => 1, good => 0, tests => 1, sub_skipped=> 1, skipped => 0 }, duplicates => { bonus => 0, max => 10, ok => 11, files => 1, bad => 1, good => 0, tests => 1, sub_skipped=> 0, skipped => 0, }, header_at_end => { bonus => 0, max => 4, ok => 4, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 0, skipped => 0, }, skip_all => { bonus => 0, max => 0, ok => 0, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 0, skipped => 1, }, with_comments => { bonus => 2, max => 5, ok => 5, files => 1, bad => 0, good => 1, tests => 1, sub_skipped=> 0, skipped => 0, }, ); $Total_tests = keys(%samples) + 1; } tie *NULL, 'My::Dev::Null' or die $!; while (my($test, $expect) = each %samples) { # _runtests() runs the tests but skips the formatting. my($totals, $failed); eval { select NULL; # _runtests() isn't as quiet as it should be. ($totals, $failed) = Test::Harness::_runtests("lib/sample-tests/$test"); }; select STDOUT; unless( $@ ) { ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), $test ); } else { # special case for bailout ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i), $test ); } }