This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Adding todo tests
authorMichael G. Schwern <schwern@pobox.com>
Sun, 18 Feb 2001 01:48:50 +0000 (20:48 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 18 Feb 2001 17:10:53 +0000 (17:10 +0000)
Message-ID: <20010218014850.C19957@magnonel.guild.net>

p4raw-id: //depot/perl@8824

lib/Test/Harness.pm
t/TEST
t/op/chop.t

index adfc170..ab913f7 100644 (file)
@@ -318,37 +318,47 @@ sub _parse_test_line {
     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 @@ Test::Harness - run perl standard test scripts with statistics
 
 =head1 SYNOPSIS
 
-use Test::Harness;
+  use Test::Harness;
 
-runtests(@tests);
+  runtests(@test_files);
 
 =head1 DESCRIPTION
 
@@ -635,6 +645,9 @@ performance statistics that are computed by the Benchmark module.
 
 =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 @@ script(s). The default value is C<-w>.
 
 =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 @@ the script dies with this message.
 
 =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> 
 
-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).
+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).
 
-Setting C<HARNESS_COMPILE_TEST> to a true value will make harness attempt
-to compile the test using C<perlcc> before running it.
+=item C<HARNESS_COMPILE_TEST> 
 
-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 true it will make harness attempt to compile the test using
+C<perlcc> before running it.
+
+=item C<HARNESS_FILELEAK_IN_DIR> 
+
+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 @@ If relative, directory name is with respect to the current directory at
 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.
+=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.
 
-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.
+=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
 
-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.
 
 =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 <andreas.koenig@anima.de> and
+Michael G Schwern <schwern@pobox.com>
 
 =head1 BUGS
 
diff --git a/t/TEST b/t/TEST
index cf402bd..acefb54 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -119,9 +119,20 @@ EOT
                    $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");
index 65d0669..9eddded 100755 (executable)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..33\n";
+print "1..34\n";
 
 # optimized
 
@@ -103,3 +103,7 @@ print $_ eq "abc\x{1234}" ? "ok 32\n" : "not ok 32\n";
 $_ = "\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";