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
--- /dev/null
+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<skip> 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<Test::Harness> 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
@ISA @EXPORT @EXPORT_OK);
$have_devel_corestack = 0;
-$VERSION = "1.1502";
+$VERSION = "1.1601";
@ISA=('Exporter');
@EXPORT= qw(&runtests);
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;
$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++;
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";
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 {
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) {
=head1 DESCRIPTION
+(By using the L<Test> 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<N> is an increasing sequence of integers. The first line
output by a standard test script is C<"1..M"> with C<M> being the
=head1 SEE ALSO
-See L<Benchmark> for the underlying timing routines.
+L<Test> for writing test scripts and also L<Benchmark> for the
+underlying timing routines.
=head1 AUTHORS
projects / platform / upstream / perl.git / commitdiff