From: Joshua Pritikin Date: Sat, 14 Feb 1998 17:58:01 +0000 (-0500) Subject: allow the Test::Harness to grok TODO-type tests docs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7b13a3f5c4a3c55f3e67d28478e708443ad0675c;p=p5sagit%2Fp5-mst-13.2.git allow the Test::Harness to grok TODO-type tests docs p4raw-id: //depot/perl@539 --- diff --git a/MANIFEST b/MANIFEST index 84d6506..3287d16 100644 --- a/MANIFEST +++ b/MANIFEST @@ -424,6 +424,7 @@ lib/Sys/Syslog.pm Perl module supporting syslogging lib/Term/Cap.pm Perl module supporting termcap usage lib/Term/Complete.pm A command completion subroutine lib/Term/ReadLine.pm Stub readline library +lib/Test.pm A simple framework for writing test scripts lib/Test/Harness.pm A test harness lib/Text/Abbrev.pm An abbreviation table builder lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter diff --git a/lib/Test.pm b/lib/Test.pm new file mode 100644 index 0000000..7e79da2 --- /dev/null +++ b/lib/Test.pm @@ -0,0 +1,134 @@ +use strict; +package Test; +use Test::Harness 1.1601 (); +use Carp; +use vars qw($VERSION @ISA @EXPORT $ntest %todo); +$VERSION = '0.06'; +require Exporter; +@ISA=('Exporter'); +@EXPORT= qw(&plan &ok &skip $ntest); + +$|=1; +#$^W=1; ? +$ntest=1; + +# Use of this variable is strongly discouraged. It is set +# exclusively for test coverage analyzers. +$ENV{REGRESSION_TEST} = $0; + +sub plan { + croak "Test::plan(%args): odd number of arguments" if @_ & 1; + my $max=0; + for (my $x=0; $x < @_; $x+=2) { + my ($k,$v) = @_[$x,$x+1]; + if ($k =~ /^test(s)?$/) { $max = $v; } + elsif ($k eq 'todo' or + $k eq 'failok') { for (@$v) { $todo{$_}=1; }; } + else { carp "Test::plan(): skipping unrecognized directive '$k'" } + } + my @todo = sort { $a <=> $b } keys %todo; + if (@todo) { + print "1..$max todo ".join(' ', @todo).";\n"; + } else { + print "1..$max\n"; + } +} + +sub ok { + my ($ok, $guess) = @_; + carp "(this is ok $ntest)" if defined $guess && $guess != $ntest; + $ok = $ok->() if (ref $ok or '') eq 'CODE'; + if ($ok) { + if ($todo{$ntest}) { + print("ok $ntest # Wow!\n"); + } else { + print("ok $ntest # (failure expected)\n"); + } + } else { + print("not ok $ntest\n"); + } + ++ $ntest; + $ok; +} + +sub skip { + my ($toskip, $ok, $guess) = @_; + carp "(this is skip $ntest)" if defined $guess && $guess != $ntest; + $toskip = $toskip->() if (ref $toskip or '') eq 'CODE'; + if ($toskip) { + print "ok $ntest # skip\n"; + ++ $ntest; + 1; + } else { + ok($ok); + } +} + +1; +__END__ + +=head1 NAME + + Test - provides a simple framework for writing test scripts + +=head1 SYNOPSIS + + use strict; + use Test; + BEGIN { plan tests => 5, todo => [3,4] } + + ok(0); #failure + ok(1); #success + + ok(0); #ok, expected failure (see todo above) + ok(1); #surprise success! + + skip($feature_is_missing, sub {...}); #do platform specific test + +=head1 DESCRIPTION + +Test::Harness expects to see particular output when it executes test +scripts. This module tries to make conforming just a little bit +easier (and less error prone). + +=head1 TEST CATEGORIES + +=over 4 + +=item * NORMAL TESTS + +These tests are expected to succeed. If they don't, something is +wrong! + +=item * SKIPPED TESTS + +C should be used to skip tests for which a platform specific +feature isn't available. + +=item * TODO TESTS + +TODO tests are designed for the purpose of maintaining an executable +TODO list. These tests are expected NOT to succeed (otherwise the +feature they test would be on the new feature list, not the TODO +list). + +Packages should NOT be released with successful TODO tests. As soon +as a TODO test starts working, it should be promoted to a normal test +and the new feature should be documented in the release notes. + +=back + +=head1 SEE ALSO + +L and various test coverage analysis tools. + +=head1 AUTHOR + +Copyright © 1998 Joshua Nathaniel Pritikin. All rights reserved. + +This package is free software and is provided "as is" without express +or implied warranty. It may be used, redistributed and/or modified +under the terms of the Perl Artistic License (see +http://www.perl.com/perl/misc/Artistic.html) + +=cut diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 37f4a9f..8102ff4 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -11,7 +11,7 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest @ISA @EXPORT @EXPORT_OK); $have_devel_corestack = 0; -$VERSION = "1.1502"; +$VERSION = "1.1601"; @ISA=('Exporter'); @EXPORT= qw(&runtests); @@ -43,7 +43,7 @@ $switches = "-w"; sub runtests { my(@tests) = @_; local($|) = 1; - my($test,$te,$ok,$next,$max,$pct,$totok,@failed,%failedtests); + my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests); my $totmax = 0; my $files = 0; my $bad = 0; @@ -73,12 +73,20 @@ sub runtests { $fh->open($cmd) or print "can't run $test. $!\n"; $ok = $next = $max = 0; @failed = (); + my %todo = (); + my $bonus = 0; my $skipped = 0; while (<$fh>) { if( $verbose ){ print $_; } - if (/^1\.\.([0-9]+)/) { + if (/^1\.\.([0-9]+) todo([\d\s]+)\;/) { + $max = $1; + for (split(/\s+/, $2)) { $todo{$_} = 1; } + $totmax += $max; + $files++; + $next = 1; + } elsif (/^1\.\.([0-9]+)/) { $max = $1; $totmax += $max; $files++; @@ -87,12 +95,18 @@ sub runtests { my $this = $next; if (/^not ok\s*(\d*)/){ $this = $1 if $1 > 0; - push @failed, $this; + if (!$todo{$this}) { + push @failed, $this; + } else { + $ok++; + $totok++; + } } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) { $this = $1 if $1 > 0; $ok++; $totok++; $skipped++ if defined $2; + $bonus++, $totbonus++ if $todo{$this}; } if ($this > $next) { # warn "Test output counter mismatch [test $this]\n"; @@ -144,9 +158,14 @@ sub runtests { estat => $estatus, wstat => $wstatus, }; } elsif ($ok == $max && $next == $max+1) { - if ($max and $skipped) { - my $ender = 's' x ($skipped > 1); - print "ok, $skipped subtest$ender skipped on this platform\n"; + if ($max and $skipped + $bonus) { + my @msg; + push(@msg, "$skipped subtest".($skipped>1?'s':'')." skipped") + if $skipped; + push(@msg, "$bonus subtest".($bonus>1?'s':''). + " unexpectedly succeeded") + if $bonus; + print "ok, ".join(', ', @msg)."\n"; } elsif ($max) { print "ok\n"; } else { @@ -193,8 +212,12 @@ sub runtests { delete $ENV{PERL5LIB}; } } + my $bonusmsg = ''; + $bonusmsg = (" ($totbonus subtest".($totbonus>1?'s':''). + " UNEXPECTEDLY SUCCEEDED)") + if $totbonus; if ($bad == 0 && $totmax) { - print "All tests successful.\n"; + print "All tests successful$bonusmsg.\n"; } elsif ($total==0){ die "FAILED--no tests were run for some reason.\n"; } elsif ($totmax==0) { @@ -289,6 +312,10 @@ runtests(@tests); =head1 DESCRIPTION +(By using the L module, you can write test scripts without +knowing the exact output this module expects. However, if you need to +know the specifics, read on!) + Perl test scripts print to standard output C<"ok N"> for each single test, where C is an increasing sequence of integers. The first line output by a standard test script is C<"1..M"> with C being the @@ -372,7 +399,8 @@ above messages. =head1 SEE ALSO -See L for the underlying timing routines. +L for writing test scripts and also L for the +underlying timing routines. =head1 AUTHORS