A few weeks ago I brought up the idea of unifying the format of todo tests and skip tests: http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-01/msg00883.html Well, here it is. This is a patch to both t/TEST and Test::Harness so they honor this style of test output: not ok 13 # TODO cure cancer to allow us to write tests for features yet implemented or bugs yet to be fixed. I think this will improve our handling of minor bugs and features which can't be fixed immediately. Rather than "that would be nice, but we're short on tuits" and then forgetting about it until the next bug report, we can add a todo test at that point. Then at least we'll be reminded of it. We'll also know if the bug/feature is "accidentally" fixed. At the moment, todo tests wil not be reported if they fail and will only be reported if the unexpectedly succeed. In the future, we'll develop a slightly modified harness to run the test suite and report back only the todo list. The old (and fortunately undocumented) style of declaring todo tests which Test.pm uses is still honored, but its format will not be documented. Test.pm will eventually be updated to use the new format. Along with this change, I've added the first todo test. One to remind us that chop(LIST)'s return value is broken. I've also done some minor reformatting of Test::Harness's docs. Finally, I've added myself Test::Harness as a maintainer if Andreas doesn't mind? --- t/TEST 2001/02/18 03:26:25 1.3 +++ t/TEST 2001/02/18 04:06:07 @@ -119,9 +119,20 @@ $ok = 1; } else { - $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; - if (/^ok (\d+)(\s*#.*)?/ && $1 == $next) { - $next = $next + 1; + if (/^(not )?ok (\d+)(\s*#.*)?/ && + $2 == $next) + { + my($not, $num, $extra) = ($1, $2, $3); + my($istodo) = $extra =~ /^\s*#\s*TODO/ if $extra; + + if( $not && !$istodo ) { + $ok = 0; + $next = $num; + last; + } + else { + $next = $next + 1; + } } elsif (/^Bail out!\s*(.*)/i) { # magic words die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n"); --- lib/Test/Harness.pm 2001/02/18 04:12:41 1.1 +++ lib/Test/Harness.pm 2001/02/18 06:33:26 @@ -318,37 +318,47 @@ if ($line =~ /^(not\s+)?ok\b/i) { my $this = $test->{next} || 1; # "not ok 23" - if ($line =~ /^not ok\s*(\d*)/){ # test failed - $this = $1 if length $1 and $1 > 0; - print "$test->{ml}NOK $this" if $test->{ml}; - if (!$test->{todo}{$this}) { - push @{$test->{failed}}, $this; - } else { - $test->{ok}++; - $tot->{ok}++; - } - } - # "ok 23 # skip (you're not cleared for that)" - elsif ($line =~ /^ok\s*(\d*)\ * - (\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)? - /x) # test skipped - { - $this = $1 if length $1 and $1 > 0; - print "$test->{ml}ok $this/$test->{max}" if $test->{ml}; - $test->{ok}++; - $tot->{ok}++; - $test->{skipped}++ if defined $2; - my $reason; - $reason = 'unknown reason' if defined $2; - $reason = $3 if defined $3; - if (defined $reason and defined $test->{skip_reason}) { - # print "was: '$skip_reason' new '$reason'\n"; - $test->{skip_reason} = 'various reasons' - if $test->{skip_reason} ne $reason; - } elsif (defined $reason) { - $test->{skip_reason} = $reason; - } - $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this}; + if ($line =~ /^(not )?ok\s*(\d*)(\s*#.*)?/) { + my($not, $tnum, $extra) = ($1, $2, $3); + + $this = $tnum if $tnum; + + my($type, $reason) = $extra =~ /^\s*#\s*([Ss]kip\S*|TODO)(\s+.+)?/ + if defined $extra; + + my($istodo, $isskip); + if( defined $type ) { + $istodo = $type =~ /TODO/; + $isskip = $type =~ /skip/i; + } + + $test->{todo}{$tnum} = 1 if $istodo; + + if( $not ) { + print "$test->{ml}NOK $this" if $test->{ml}; + if (!$test->{todo}{$this}) { + push @{$test->{failed}}, $this; + } else { + $test->{ok}++; + $tot->{ok}++; + } + } + else { + print "$test->{ml}ok $this/$test->{max}" if $test->{ml}; + $test->{ok}++; + $tot->{ok}++; + $test->{skipped}++ if $isskip; + + if (defined $reason and defined $test->{skip_reason}) { + # print "was: '$skip_reason' new '$reason'\n"; + $test->{skip_reason} = 'various reasons' + if $test->{skip_reason} ne $reason; + } elsif (defined $reason) { + $test->{skip_reason} = $reason; + } + + $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this}; + } } # XXX ummm... dunno elsif ($line =~ /^ok\s*(\d*)\s*\#([^\r]*)$/) { # XXX multiline ok? @@ -612,9 +622,9 @@ =head1 SYNOPSIS -use Test::Harness; + use Test::Harness; -runtests(@tests); + runtests(@test_files); =head1 DESCRIPTION @@ -635,6 +645,9 @@ =head2 The test script output +The following explains how Test::Harness interprets the output of your +test program. + =over 4 =item B<1..M> @@ -700,17 +713,36 @@ =item B<Skipping tests> -If the standard output line contains substring C< # Skip> (with +If the standard output line contains the substring C< # Skip> (with variations in spacing and case) after C<ok> or C<ok NUMBER>, it is counted as a skipped test. If the whole testscript succeeds, the count of skipped tests is included in the generated output. - C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason -for skipping. Similarly, one can include a similar explanation in a -C<1..0> line emitted if the test script is skipped completely: +for skipping. + + ok 23 # skip Insufficient flogiston pressure. + +Similarly, one can include a similar explanation in a C<1..0> line +emitted if the test script is skipped completely: 1..0 # Skipped: no leverage found +=item B<Todo tests> + +If the standard output line contains the substring C< # TODO> after +C<not ok> or C<not ok NUMBER>, it is counted as a todo test. The text +afterwards is the thing that has to be done before this test will +succeed. + + not ok 13 # TODO harness the power of the atom + +These tests represent a feature to be implemented or a bug to be fixed +and act as something of an executable "thing to do" list. They are +B<not> expected to succeed. Should a todo test begin succeeding, +Test::Harness will report it as a bonus. This indicates that whatever +you were supposed to do has been done and you should promote this to a +normal test. + =item B<Bail out!> As an emergency measure, a test script can decide that further tests @@ -776,21 +808,29 @@ =head1 ENVIRONMENT -Setting C<HARNESS_IGNORE_EXITCODE> makes harness ignore the exit status -of child processes. +=over 4 + +=item C<HARNESS_IGNORE_EXITCODE> + +Makes harness ignore the exit status of child processes when defined. + +=item C<HARNESS_NOTTY> + +When set to a true value, forces it to behave as though STDOUT were +not a console. You may need to set this if you don't want harness to +output more frequent progress messages using carriage returns. Some +consoles may not handle carriage returns properly (which results in a +somewhat messy output). + +=item C<HARNESS_COMPILE_TEST> + +When true it will make harness attempt to compile the test using +C<perlcc> before running it. + +=item C<HARNESS_FILELEAK_IN_DIR> -Setting C<HARNESS_NOTTY> to a true value forces it to behave as though -STDOUT were not a console. You may need to set this if you don't want -harness to output more frequent progress messages using carriage returns. -Some consoles may not handle carriage returns properly (which results -in a somewhat messy output). - -Setting C<HARNESS_COMPILE_TEST> to a true value will make harness attempt -to compile the test using C<perlcc> before running it. - -If C<HARNESS_FILELEAK_IN_DIR> is set to the name of a directory, harness -will check after each test whether new files appeared in that directory, -and report them as +When set to the name of a directory, harness will check after each +test whether new files appeared in that directory, and report them as LEAKED FILES: scr.tmp 0 my.db @@ -798,32 +838,42 @@ the moment runtests() was called. Putting absolute path into C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results. -The value of C<HARNESS_PERL_SWITCHES> will be prepended to the -switches used to invoke perl on each test. For example, setting -C<HARNESS_PERL_SWITCHES> to "-W" will run all tests with all -warnings enabled. - -If C<HARNESS_COLUMNS> is set, then this value will be used for the -width of the terminal. If it is not set then it will default to -C<COLUMNS>. If this is not set, it will default to 80. Note that users -of Bourne-sh based shells will need to C<export COLUMNS> for this -module to use that variable. - -Harness sets C<HARNESS_ACTIVE> before executing the individual tests. -This allows the tests to determine if they are being executed through the -harness or by any other means. +=item C<HARNESS_PERL_SWITCHES> + +Its value will be prepended to the switches used to invoke perl on +each test. For example, setting C<HARNESS_PERL_SWITCHES> to "-W" will +run all tests with all warnings enabled. + +=item C<HARNESS_COLUMNS> + +This value will be used for the width of the terminal. If it is not +set then it will default to C<COLUMNS>. If this is not set, it will +default to 80. Note that users of Bourne-sh based shells will need to +C<export COLUMNS> for this module to use that variable. + +=item C<HARNESS_ACTIVE> + +Harness sets this before executing the individual tests. This allows +the tests to determine if they are being executed through the harness +or by any other means. + +=back + =head1 SEE ALSO -L<Test> for writing test scripts and also L<Benchmark> for the -underlying timing routines. +L<Test> for writing test scripts, L<Benchmark> for the underlying +timing routines and L<Devel::Coverage> for test coverage analysis. =head1 AUTHORS Either Tim Bunce or Andreas Koenig, we don't know. What we know for sure is, that it was inspired by Larry Wall's TEST script that came with perl distributions for ages. Numerous anonymous contributors -exist. Current maintainer is Andreas Koenig. +exist. + +Current maintainers are Andreas Koenig <[EMAIL PROTECTED]> and +Michael G Schwern <[EMAIL PROTECTED]> =head1 BUGS --- t/op/chop.t 2001/02/18 04:06:44 1.1 +++ t/op/chop.t 2001/02/18 04:08:53 @@ -1,6 +1,6 @@ #!./perl -print "1..33\n"; +print "1..34\n"; # optimized @@ -103,3 +103,7 @@ $_ = "\x{1234}\x{2345}"; chop; print $_ eq "\x{1234}" ? "ok 33\n" : "not ok 33\n"; + +# TODO! Make sure chop(LIST) returns the right value. +my @stuff = qw(this that); +print chop(@stuff[0,1]) eq 't' ? "ok 34 # TODO\n" : "not ok 34 # TODO\n";
