From: Nick Ing-Simmons Date: Mon, 5 Feb 2001 19:39:31 +0000 (+0000) Subject: Missed file f#rom the testharness mess. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=66375e66fe2a034eed6488ccdd02bb217c879f44;p=p5sagit%2Fp5-mst-13.2.git Missed file f#rom the testharness mess. p4raw-id: //depot/perl@8698 --- diff --git a/t/lib/test-harness.t b/t/lib/test-harness.t new file mode 100644 index 0000000..90326d9 --- /dev/null +++ b/t/lib/test-harness.t @@ -0,0 +1,202 @@ +#!./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) = @_; + print "not " unless $test; + print "ok $test_num"; + print " - $name" if defined $name; + print "\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 ); + } +}