rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity
e3bdec83b4
perl/perl-5.10.0-removeTestHarness.patch
Marcela Mašláňová 325b0b7652 - 451078 update Test::Harness to 3.12 for more testing. Removed verbose 
test, new Test::Harness has possibly verbose output, but updated
    package has a lot of features f.e. TAP::Harness. Carefully watched all
    new bugs related to tests!
2008-07-02 14:02:55 +00:00

5973 lines
181 KiB
Diff
Raw Blame History

diff -urN Test.old/Harness/Assert.pm Test/Harness/Assert.pm
--- perl-5.10.0/lib/Test.old/Harness/Assert.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Assert.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,64 +0,0 @@
-package Test::Harness::Assert;
-
-use strict;
-require Exporter;
-use vars qw($VERSION @EXPORT @ISA);
-
-$VERSION = '0.02';
-
-@ISA = qw(Exporter);
-@EXPORT = qw(assert);
-
-
-=head1 NAME
-
-Test::Harness::Assert - simple assert
-
-=head1 SYNOPSIS
-
- ### FOR INTERNAL USE ONLY ###
-
- use Test::Harness::Assert;
-
- assert( EXPR, $name );
-
-=head1 DESCRIPTION
-
-A simple assert routine since we don't have Carp::Assert handy.
-
-B<For internal use by Test::Harness ONLY!>
-
-=head1 FUNCTIONS
-
-=head2 C<assert()>
-
- assert( EXPR, $name );
-
-If the expression is false the program aborts.
-
-=cut
-
-sub assert ($;$) {
- my($assert, $name) = @_;
-
- unless( $assert ) {
- require Carp;
- my $msg = 'Assert failed';
- $msg .= " - '$name'" if defined $name;
- $msg .= '!';
- Carp::croak($msg);
- }
-
-}
-
-=head1 AUTHOR
-
-Michael G Schwern C<< <schwern at pobox.com> >>
-
-=head1 SEE ALSO
-
-L<Carp::Assert>
-
-=cut
-
-1;
diff -urN Test.old/Harness/bin/prove Test/Harness/bin/prove
--- perl-5.10.0/lib/Test.old/Harness/bin/prove 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/bin/prove 1970-01-01 01:00:00.000000000 +0100
@@ -1,292 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use Test::Harness;
-use Test::Harness::Util qw( all_in blibdirs shuffle );
-
-use Getopt::Long;
-use Pod::Usage 1.12;
-use File::Spec;
-
-use vars qw( $VERSION );
-$VERSION = '2.64';
-
-my $shuffle = 0;
-my $dry = 0;
-my $blib = 0;
-my $lib = 0;
-my $recurse = 0;
-my @includes = ();
-my @switches = ();
-
-# Allow cuddling the paths with the -I
-@ARGV = map { /^(-I)(.+)/ ? ($1,$2) : $_ } @ARGV;
-
-# Stick any default switches at the beginning, so they can be overridden
-# by the command line switches.
-unshift @ARGV, split( ' ', $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES};
-
-Getopt::Long::Configure( 'no_ignore_case' );
-Getopt::Long::Configure( 'bundling' );
-GetOptions(
- 'b|blib' => \$blib,
- 'd|debug' => \$Test::Harness::debug,
- 'D|dry' => \$dry,
- 'h|help|?' => sub {pod2usage({-verbose => 1}); exit},
- 'H|man' => sub {pod2usage({-verbose => 2}); exit},
- 'I=s@' => \@includes,
- 'l|lib' => \$lib,
- 'perl=s' => \$ENV{HARNESS_PERL},
- 'r|recurse' => \$recurse,
- 's|shuffle' => \$shuffle,
- 't' => sub { unshift @switches, '-t' }, # Always want -t up front
- 'T' => sub { unshift @switches, '-T' }, # Always want -T up front
- 'w' => sub { push @switches, '-w' },
- 'W' => sub { push @switches, '-W' },
- 'strap=s' => \$ENV{HARNESS_STRAP_CLASS},
- 'timer' => \$Test::Harness::Timer,
- 'v|verbose' => \$Test::Harness::verbose,
- 'V|version' => sub { print_version(); exit; },
-) or exit 1;
-
-$ENV{TEST_VERBOSE} = 1 if $Test::Harness::verbose;
-
-# Handle blib includes
-if ( $blib ) {
- my @blibdirs = blibdirs();
- if ( @blibdirs ) {
- unshift @includes, @blibdirs;
- }
- else {
- warn "No blib directories found.\n";
- }
-}
-
-# Handle lib includes
-if ( $lib ) {
- unshift @includes, 'lib';
-}
-
-# Build up TH switches
-push( @switches, map { /\s/ && !/^".*"$/ ? qq["-I$_"] : "-I$_" } @includes );
-$Test::Harness::Switches = join( ' ', @switches );
-print "# \$Test::Harness::Switches: $Test::Harness::Switches\n" if $Test::Harness::debug;
-
-@ARGV = File::Spec->curdir unless @ARGV;
-my @argv_globbed;
-my @tests;
-if ( $] >= 5.006001 ) {
- require File::Glob;
- @argv_globbed = map { File::Glob::bsd_glob($_) } @ARGV;
-}
-else {
- @argv_globbed = map { glob } @ARGV;
-}
-
-for ( @argv_globbed ) {
- push( @tests, -d $_ ? all_in( { recurse => $recurse, start => $_ } ) : $_ )
-}
-
-if ( @tests ) {
- shuffle(@tests) if $shuffle;
- if ( $dry ) {
- print join( "\n", @tests, '' );
- }
- else {
- print "# ", scalar @tests, " tests to run\n" if $Test::Harness::debug;
- runtests(@tests);
- }
-}
-
-sub print_version {
- printf( "prove v%s, using Test::Harness v%s and Perl v%vd\n",
- $VERSION, $Test::Harness::VERSION, $^V );
-}
-
-__END__
-
-=head1 NAME
-
-prove -- A command-line tool for running tests against Test::Harness
-
-=head1 SYNOPSIS
-
-prove [options] [files/directories]
-
-=head1 OPTIONS
-
- -b, --blib Adds blib/lib to the path for your tests, a la "use blib"
- -d, --debug Includes extra debugging information
- -D, --dry Dry run: Show the tests to run, but don't run them
- -h, --help Display this help
- -H, --man Longer manpage for prove
- -I Add libraries to @INC, as Perl's -I
- -l, --lib Add lib to the path for your tests
- --perl Sets the name of the Perl executable to use
- -r, --recurse Recursively descend into directories
- -s, --shuffle Run the tests in a random order
- --strap Define strap class to use
- -T Enable tainting checks
- -t Enable tainting warnings
- --timer Print elapsed time after each test file
- -v, --verbose Display standard output of test scripts while running them
- -V, --version Display version info
-
-Single-character options may be stacked. Default options may be set by
-specifying the PROVE_SWITCHES environment variable.
-
-=head1 OVERVIEW
-
-F<prove> is a command-line interface to the test-running functionality
-of C<Test::Harness>. With no arguments, it will run all tests in the
-current directory.
-
-Shell metacharacters may be used with command lines options and will be exanded
-via C<File::Glob::bsd_glob>.
-
-=head1 PROVE VS. "MAKE TEST"
-
-F<prove> has a number of advantages over C<make test> when doing development.
-
-=over 4
-
-=item * F<prove> is designed as a development tool
-
-Perl users typically run the test harness through a makefile via
-C<make test>. That's fine for module distributions, but it's
-suboptimal for a test/code/debug development cycle.
-
-=item * F<prove> is granular
-
-F<prove> lets your run against only the files you want to check.
-Running C<prove t/live/ t/master.t> checks every F<*.t> in F<t/live>,
-plus F<t/master.t>.
-
-=item * F<prove> has an easy verbose mode
-
-F<prove> has a C<-v> option to see the raw output from the tests.
-To do this with C<make test>, you must set C<HARNESS_VERBOSE=1> in
-the environment.
-
-=item * F<prove> can run under taint mode
-
-F<prove>'s C<-T> runs your tests under C<perl -T>, and C<-t> runs them
-under C<perl -t>.
-
-=item * F<prove> can shuffle tests
-
-You can use F<prove>'s C<--shuffle> option to try to excite problems
-that don't show up when tests are run in the same order every time.
-
-=item * F<prove> doesn't rely on a make tool
-
-Not everyone wants to write a makefile, or use L<ExtUtils::MakeMaker>
-to do so. F<prove> has no external dependencies.
-
-=item * Not everything is a module
-
-More and more users are using Perl's testing tools outside the
-context of a module distribution, and may not even use a makefile
-at all.
-
-=back
-
-=head1 COMMAND LINE OPTIONS
-
-=head2 -b, --blib
-
-Adds blib/lib to the path for your tests, a la "use blib".
-
-=head2 -d, --debug
-
-Include debug information about how F<prove> is being run. This
-option doesn't show the output from the test scripts. That's handled
-by -v,--verbose.
-
-=head2 -D, --dry
-
-Dry run: Show the tests to run, but don't run them.
-
-=head2 -I
-
-Add libraries to @INC, as Perl's -I.
-
-=head2 -l, --lib
-
-Add C<lib> to @INC. Equivalent to C<-Ilib>.
-
-=head2 --perl
-
-Sets the C<HARNESS_PERL> environment variable, which controls what
-Perl executable will run the tests.
-
-=head2 -r, --recurse
-
-Descends into subdirectories of any directories specified, looking for tests.
-
-=head2 -s, --shuffle
-
-Sometimes tests are accidentally dependent on tests that have been
-run before. This switch will shuffle the tests to be run prior to
-running them, thus ensuring that hidden dependencies in the test
-order are likely to be revealed. The author hopes the run the
-algorithm on the preceding sentence to see if he can produce something
-slightly less awkward.
-
-=head2 --strap
-
-Sets the HARNESS_STRAP_CLASS variable to set which Test::Harness::Straps
-variable to use in running the tests.
-
-=head2 -t
-
-Runs test programs under perl's -t taint warning mode.
-
-=head2 -T
-
-Runs test programs under perl's -T taint mode.
-
-=head2 --timer
-
-Print elapsed time after each test file
-
-=head2 -v, --verbose
-
-Display standard output of test scripts while running them. Also sets
-TEST_VERBOSE in case your tests rely on them.
-
-=head2 -V, --version
-
-Display version info.
-
-=head1 BUGS
-
-Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
-You can also mail bugs, fixes and enhancements to
-C<< <bug-test-harness@rt.cpan.org> >>.
-
-=head1 TODO
-
-=over 4
-
-=item *
-
-Shuffled tests must be recreatable
-
-=back
-
-=head1 AUTHORS
-
-Andy Lester C<< <andy at petdance.com> >>
-
-=head1 COPYRIGHT
-
-Copyright 2004-2006 by Andy Lester C<< <andy at petdance.com> >>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>.
-
-=cut
diff -urN Test.old/Harness/Changes Test/Harness/Changes
--- perl-5.10.0/lib/Test.old/Harness/Changes 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Changes 1970-01-01 01:00:00.000000000 +0100
@@ -1,727 +0,0 @@
-Revision history for Perl extension Test::Harness
-
-NEXT
- [FIXES]
- * prove's --perl=/path/to/file wasn't taking a value.
- * prove's version number was not getting incremented. From now on,
- prove's $VERSION will match Test::Harness's $VERSION, and I added
- a test to make sure this is the case.
-
- [ENHANCEMENTS]
- * Added test straps overload via HARNESS_STRAP_OVERLOAD environment
- variable. prove now takes a --strap=class parameter. Thanks,
- Adam Kennedy.
-
-2.63_01 Fri Jun 30 16:59:50 CDT 2006
- [ENHANCEMENTS]
- * Failed tests used to say "NOK x", and now say "NOK x/y".
- Thanks to Will Coleda.
-
- * Added the Test::Harness::Results object, so we have a well-defined
- object, and not just a hash that we pass around. Thanks to YAPC::NA
- 2006 Hackathon!
-
-2.62 Thu Jun 8 14:11:57 CDT 2006
- [FIXES]
- * Restored the behavior of dying if any subtests failed. This is a
- pretty crucial bug that I should have fixed long ago. Not having this
- means that CPANPLUS will install modules even if their tests fail. :-(
-
-2.60 Wed May 24 14:48:44 CDT 2006
- [FIXES]
- * Fixed the headers in the summary failure table.
-
-2.58 Sat May 13 22:53:53 CDT 2006
- No changes. Released to the world with a non-beta number.
-
-2.57_06 Sun Apr 23 00:55:43 CDT 2006
- [THINGS THAT MIGHT BREAK YOUR CODE]
- * Anything that displays a percentage of tests passed has been
- removed. Output at the end of failing runs is now different.
-
- [FIXES]
- * Fixed the TODO-passing patch from 2.57_05.
-
- [ENHANCEMENTS]
- * The unnecessary display of percentages of tests passing and failing
- have been removed. Tests are not a percentage game.
-
- * Caches the results of _default_inc(), which is expensive because
- of shelling out to get the pathnames. Benchmarking was showing that
- 15% of Test::Harness's time was spent in this function. For test
- suites with many test files, this can be significant. With this
- speedup, the "make test" for the Perl core speeds up 2.5%.
- Thanks to Nicholas Clark for finding this.
-
- [DOCUMENTATION]
- * Fixed HARNESS_PERL_SWITCHES typo. Thanks, Andreas Koenig.
-
- * Added docs on HARNESS_TIMER and --timer. Thanks, Mike O'Regan.
-
-2.57_05 Wed Apr 19 00:31:10 CDT 2006
- [ENHANCEMENTS]
- * Now shows details of the tests that unexpectedly pass, instead of
- just giving a number. Thanks, demerphq!
-
- [INTERNALS]
- * Fixed globbing to work under Perls before 5.6.0. Before Perl 5.6.0,
- prove just uses the internal glob() function.
-
-2.57_04 Mon Apr 17 13:35:10 CDT 2006
- [ENHANCEMENTS]
- * prove's globbing is now done with File::Glob::bsd_glob().
- Otherwise, "prove c:\program files\svk\t\*" fails because glob()
- considers it to be two patterns, splitting on whitespace. Thanks to
- Audrey Tang.
-
- [DOCUMENTATION]
- * Added information about other TAP implementations in other languages.
-
-2.57_03 Dec 31 2005
-
- [THINGS THAT MAY BREAK YOUR CODE]
- * Internal functions _run_all_tests() and _show_results() no longer
- exist. You shouldn't have been using them anyway since they're
- prepended with underscores.
-
- [INTERNALS]
- * Added the ability to send test output to a filehandle of
- one's choosing. Two internal functions are now exposed:
- execute_tests() and get_results() (formerly _run_all_tests() and
- _show_results()). This should allow CPANPLUS to work properly
- with Module::Build. Thanks to Ken Williams.
-
- [DOCUMENTATION]
- * Hid the documentation for the private methods in Test::Harness::Straps.
-
-2.57_02 Fri Dec 30 23:51:17 CST 2005
- [THINGS THAT MAY BREAK YOUR CODE]
- * prove's --ext option has been removed. I'm betting that nobody used it.
-
- [ENHANCEMENTS]
- * prove can now take -w and -W switches, analogous to those in perl.
- This means that "prove -wlb t/*.t" is exactly the same as "make test".
- Thanks to Rob Kinyon.
- * Started a Test::Harness::Util module for code that may be reused
- by other Harness-using modules.
-
- [INTERNALS]
- * The t/prove*.t tests now use $^X to call prove. Thanks to Yves Orton.
- * Test::Harness::Straps no longer uses Win32::GetShortPathName().
- Thanks to Gisle Aas.
-
-2.57_01 Mon Dec 26 01:39:07 CST 2005
- [FIXES]
- * Removed code and docs mentioning HARNESS_IGNORE_EXITCODE, which
- is not used anywhere.
-
- [ENHANCEMENTS]
- * If we have hi-res timings, then they're shown in integer
- milliseconds, rather than fractional seconds.
-
- * Added the --perl switch to prove.
-
- [DOCUMENTATION]
- * Added links to CPAN support sites.
-
-2.56 Wed Sep 28 16:04:00 CDT 2005
- [FIXES]
- * Incorporate bleadperl patch to fix Test::Harness on VMS.
-
-2.54 Wed Sep 28 09:52:19 CDT 2005
- [FIXES]
- * Test counts were wrong, so wouldn't install on Perls < 5.8.0.
-
-2.53_02 Thu Aug 25 21:37:01 CDT 2005
- [FIXES]
- * File order in prove is now sorted within the directory. It's not
- the sorting that's important as much as the deterministic results.
- Thanks to Adam Kennedy and Casey West for pointing this out,
- independently of each other, with 12 hours of the other.
-
- [INTERNALS]
- * Fix calls to podusage() to not use the DATA typeglob. Thanks sungo.
-
-2.53_01 Sun Jul 10 10:45:27 CDT 2005
- [FIXES]
- * If we go over 100,000 tests, it used to print out a warning for
- every test over 100,000. Now, we stop after the first. Thanks to
- Sebastien Aperghis-Tramoni.
-
-2.52 Sun Jun 26 23:05:19 CDT 2005
- No changes
-
-2.51_02
- [ENHANCEMENTS]
- * The Test::Harness timer is now off by default. Set HARNESS_TIMER
- true if you want it. Added --timer flag to prove.
-
-2.50_01
- [FIXES]
- * Call CORE::time() to figure out if we should print when we're
- printing once per second. Otherwise, we're using Time::HiRes'
- version of it. Thanks, Nicholas Clark.
-
-2.50 Tue Jun 21 14:32:12 CDT 2005
- [FIXES]
- * Added some includes in t/strap-analyze.t to make Cygwin happy.
-
-2.49_02 Tue Jun 21 09:54:44 CDT 2005
- [FIXES]
- * Added some includes in t/test_harness.t to make Cygwin happy.
-
-2.49_01 Fri Jun 10 15:37:31 CDT 2005
- [ENHANCEMENTS]
- * Now shows elapsed time in 1000ths of a second if Time::HiRes
- is available.
-
- [FIXES]
- * Test::Harness::Iterator didn't have a 1; at the end. Thanks to
- Steve Peters for finding it.
-
-2.48 Fri Apr 22 22:41:46 CDT 2005
- Released after weeks of non-complaint.
-
-2.47_03 Wed Mar 2 16:52:55 CST 2005
- [THINGS THAT MIGHT BREAK YOUR CODE]
- * Test::Harness now requires Perl 5.005_03 or above.
-
- [FIXES]
- * Fixed incorrect "confused by tests in wrong order" error in 2.47_02.
-
-2.47_02 Tue Mar 1 23:15:47 CST 2005
- [THINGS THAT MIGHT BREAK YOUR CODE]
- * Test directives for skip tests used to be anything that matches
- /^skip/i, like the word "skipped", but now it must match
- /^skip\s+/i.
-
- [ENHANCEMENTS]
- * T::H now sets environment variable HARNESS_VERSION, in case a test
- program wants to know what version of T::H it's running under.
-
-2.47_01 Mon Feb 21 01:14:13 CST 2005
- [FIXES]
- * Fixed a problem submitted by Craig Berry:
-
- Several of the Test::Harness tests now fail on VMS with the
- following warning:
-
- Can't find string terminator "]" anywhere before EOF at -e line 1.
-
- The problem is that when a command is piped to the shell and that
- command has a newline character embedded in it, the part after
- the newline is invisible to the shell. The patch below corrects
- that by escaping the newline so it is not subject to variable
- interpolation until it gets to the child's Perl one-liner.
-
- [ENHANCEMENTS]
- * Test::Harness::Straps now has diagnostic gathering without changing
- how tests are run. It also adds these messages by default.
- Note that the new method, _is_diagnostic(), is for internal
- use only. It may change soon. Thanks to chromatic.
-
- [DOCUMENTATION]
- * Expanded Test::Harness::TAP.pod, and added examples.
-
- * Fixed a crucial documentation typo in Test::Harness::Straps.
-
-2.46 Thu Jan 20 11:50:59 CST 2005
- Released.
-
-2.45_02 Fri Dec 31 14:57:33 CST 2004
- [ENHANCEMENTS]
- * Turns off buffering on both STDERR and STDOUT, so that the two
- output handles don't get out of sync with each other. Thanks to
- David Wheeler.
-
- * No longer requires, or supports, the HARNESS_OK_SLOW environment
- variable. Test counts are only updated once per second, which
- used to require having HARNESS_OK_SLOW set.
-
-2.45_01 Fri Dec 17 22:39:17 CST 2004
- [THINGS THAT MIGHT BREAK YOUR CODE]
- * Test::Harness now requires Perl 5.004_05.
-
- * We no longer try to print a stack if a coredump is detected.
-
- [FIXES]
- * Reverted Test::Harness::Iterator::next()'s use of readline, since
- it fails under Perl 5.5.4.
-
- * We no longer try to print a stack if a coredump is detected.
- This means that the external problems we've had with wait.ph
- now disappear. This resolves a number of problems that various
- Linux distros have, and closes a couple of RT tickets like #2729
- and #7716.
-
- [ENHANCEMENTS]
- * Added Test::Harness->strap() method to access the internal strap.
-
- [DOCUMENTATION]
- * Obfuscated the rt.cpan.org email address. The damage is already
- done, but at least we'll have it hidden going forward.
-
-2.44 Tue Nov 30 18:38:17 CST 2004
- [INTERNALS]
- * De-anonymized the callbacks and handlers in Test::Harness, mostly
- so I can profile better.
-
- * Checks _is_header() only if _is_line() fails first. No point
- in checking every line of the input for something that can only
- occur once.
-
- * Inline the _detailize() function, which was getting called once
- per line of input. Reduced execution time about 5-7%.
-
- * Removed unnecessary temporary variables in Test::Harness::Straps
- and in Test::Harness::Iterator.
-
-2.43_02 Thu Nov 25 00:20:36 CST 2004
- [ENHANCEMENTS]
- * Added more debug output if $Test::Harness::Debug is on.
-
- [FIXES]
- * Test::Harness now removes default paths from the paths that it
- sets in PERL5LIB. This fixes RT #5649. Thanks, Schwern.
-
- [THINGS THAT MIGHT BREAK YOUR CODE]
- * Test::Harness::Straps' constructor no longer will work as an
- object method. You can't say $strap->new any more, but that's
- OK because you never really wanted to anyway.
-
-2.43_01
- [FIXES]
- * Added workaround for local $ENV{} bug on Cygwin to
- t/prove-switches.t. See the following RT tickets for details.
-
- https://rt.cpan.org/Ticket/Display.html?id=6452
- http://rt.perl.org/rt3/Ticket/Display.html?id=30952
-
-
-2.42 Wed Apr 28 22:13:11 CDT 2004
- [ENHANCEMENTS]
- * prove -v now sets TEST_VERBOSE in case your tests rely on them.
- * prove globs the command line, since Win32's shell doesn't.
-
- [FIXES]
- * Cross-platform test fixes on t/prove-globbing.t
-
-
-2.40 Tue Dec 30 20:38:59 CST 2003
- [FIXES]
- * Test::Harness::Straps should now properly quote on VMS.
-
- [ENHANCEMENTS]
- * prove now takes a -l option to add lib/ to @INC. Now when you're
- building a module, you don't have to do a make before you run
- the prove. Thanks to David Wheeler for the idea.
-
- [INTERNALS]
- * Internal functions corestatus() and canonfailed() prepended with
- underscores, to indicate such.
-
- * Gratuitous text-only changes in Test::Harness::Iterator.
-
- * All tests now do their use_ok() in a BEGIN block. Some of the
- use_ok() calls were too much of a hassle to put into a BEGIN block,
- so I changed them to regular use calls.
-
-
-2.38 Mon Nov 24 22:36:18 CST 2003
- Released. See changes below.
-
-2.37_03 Tue Nov 18 23:51:38 CST 2003
- [ENHANCEMENTS]
- * prove -V now shows the Perl version being used.
- * Now there's a HARNESS_DEBUG flag that shows diagnostics as the
- harness runs the tests. This is different from HARNESS_VERBOSE,
- which shows test output, but not information about the harness
- itself.
- * Added _command_line() to the Strap API.
-
- [FIXES]
- * Bad interaction with Module::Build: The strap was only checking
- $ENV{HARNESS_PERL_SWITCHES} for definedness, but not emptiness.
- It now also strips any leading or trailing whitesapce from the
- switches.
- * Test::Harness and prove only quote those parms that actually need
- to be quoted: Have some whitespace and aren't already quoted.
-
-2.36 Fri Nov 14 09:24:44 CST 2003
- [FIXES]
- * t/prove-includes.t properly ignores PROVE_SWITCHES that you may
- already have set.
-
-2.35_02 Thu Nov 13 09:57:36 CST 2003
- [ENHANCEMENTS]
- * prove's --blib now works just like the blib pragma.
-
-2.35_01 Wed Nov 12 23:08:45 CST 2003
- [FIXES]
- * Fixed taint-handling and path preservation under MacOS. Thanks to
- Schwern for the patch and the tests.
-
- * Preserves case of -t or -T in the shebang line of the test.
-
- [ENHANCEMENTS]
- * Added -t to prove analogous to Perl's -t. Removed the --taint
- switch.
-
- * prove can take default options from the PROVE_SWITCHES variable.
-
- * Added HARNESS_PERL to allow you to specify the Perl interpreter
- to run the tests as.
-
- * prove's --perl switch sets the HARNESS_PERL on the fly for you.
-
- * Quotes the switches and filename in the subprogram. This helps
- with filenames with spaces that are subject to shell mangling.
-
-
-2.34 Sat Nov 8 22:09:15 CST 2003
- [FIXES]
- * Allowed prove to run on Perl versions < 5.6.0.
-
- [ENHANCEMENTS]
- * Command-line switches to prove may now be stacked.
- * Added check for proper Pod::Usage version.
- * "make clean" does a better job of cleaning up after itself.
-
-
-2.32 Fri Nov 7 09:41:21 CST 2003
- Test::Harness now includes a powerful development tool to help
- programmers work with automated tests. The prove utility runs
- test files against the harness, like a "make test", but with many
- advantages:
-
- * prove is designed as a development tool
- Perl users typically run the test harness through a makefile via
- "make test". That's fine for module distributions, but it's
- suboptimal for a test/code/debug development cycle.
-
- * prove is granular
- prove lets your run against only the files you want to check.
- Running "prove t/live/ t/master.t" checks every *.t in t/live, plus
- t/master.t.
-
- * prove has an easy verbose mode
- To get full test program output from "make test", you must set
- "HARNESS_VERBOSE" in the environment. prove has a "-v" option.
-
- * prove can run under taint mode
- prove's "-T" runs your tests under "perl -T".
-
- * prove can shuffle tests
- You can use prove's "--shuffle" option to try to excite problems
- that don't show up when tests are run in the same order every time.
-
- * Not everything is a module
- More and more users are using Perl's testing tools outside the
- context of a module distribution, and may not even use a makefile at
- all.
-
- Prove requires Pod::Usage, which is standard after Perl 5.004.
-
- I'm very excited about prove, and hope that developers will begin
- adopting it to their coding cycles. I welcome your comments at
- andy@petdance.com.
-
- There are also some minor bug fixes in Test::Harness itself, listed
- below in the 2.31_* notes.
-
-
-2.31_05 Thu Nov 6 14:56:22 CST 2003
- [FIXES]
- - If a MacPerl script had a shebang with -T, the -T wouldn't get
- passed as a switch.
- - Removed the -T on three *.t files, which didn't need them, and
- which were causing problems.
- - Conditionally installs bin/prove, depending on whether Pod::Usage
- is available, which prove needs.
- - Removed old leftover code from Makefile.PL.
-
-2.31_04 Mon Nov 3 23:36:06 CST 2003
- Minor tweaks here and there, almost ready to release.
-
-2.31_03 Mon Nov 3 08:50:36 CST 2003
- [FEATURES]
- - prove is almost feature-complete. Removed the handling of
- --exclude for excluding certain tests. It may go back in the
- future.
- - prove -d is now debug. Dry is prove -D.
-
-2.31_02 Fri Oct 31 23:46:03 CST 2003
- [FEATURES]
- - Added many more switches to prove: -d for dry run, and -b for
- blib.
-
- [FIXES]
- - T:H:Straps now recognizes MSWin32 in $^0.
- - RT#3811: Could do regex matching on garbage in _is_test().
- Fixed by Yves Orton
- - RT#3827: Strips backslashes from and normalizes @INC entries
- for Win32. Fixed by Yves Orton.
-
- [INTERNALS]
- - Added $self->{_is_macos} to the T:H:Strap object.
- - t/test-harness.t sorts its test results, rather than relying on
- internal key order.
-
-2.31_01
- [FEATURES]
- - Added "prove" script to run a test or set of tests through the
- harness. Thanks to Curtis Poe for the foundation.
-
- [DOCUMENTATION]
- - Fixed POD problem in Test::Harness::Assert
-
-2.30 Thu Aug 14 20:04:00 CDT 2003
- No functional changes in this version. It's only to make some doc
- tweaks, and bump up the version number in T:H:Straps.
-
- [DOCUMENTATION]
- - Changed Schwern to Andy as the maintainer.
- - Incorporated the TODO file into Harness.pm proper.
- - Cleaned up formatting in Test::Harness::Straps.
-
-2.29 Wed Jul 17 14:08:00 CDT 2003
- - Released as 2.29.
-
-2.28_91 Sun Jul 13 00:10:00 CDT 2003
- [ENHANCEMENTS]
- - Added support for HARNESS_OK_SLOW. This will make a significant
- speedup for slower connections.
- - Folded in some changes from bleadperl that spiff up the
- failure reports.
-
- [INTERNALS]
- - Added some isa_ok() checks to the tests.
- - All Test::Harness* modules are used by use_ok()
- - Fixed the prototype for the canonfailed() function, not that
- it matters since it's never called without parens.
-
-2.28_90 Sat Jul 05 20:21:00 CDT 2003
- [ENHANCEMENTS]
- - Now, when you run a test harnessed, the numbers don't fly by one
- at a time, one update per second. This significantly speeds
- up the run time for running thousands of tests. *COUGH*
- Regexp::Common *COUGH*
-
-2.28 Thu Apr 24 14:39:00 CDT 2003
- - No functional changes.
-
-2.27_05 Mon Apr 21 15:55:00 CDT 2003
- - No functional changes.
- - Fixed circular depency in the test suite. Thanks, Rob Brown.
-
-2.27_04 Sat Apr 12 21:42:00 CDT 2003
- - Added test for $Test::Harness::Switches patch below.
-
-2.27_03 Thu Apr 03 10:47:00 CDT 2003
- - Fixed straps not respecting $Test::Harness::Switches. Thanks
- to Miyagawa for the patch.
- - Added t/pod.t to test POD validity.
-
-2.27_02 Mon Mar 24 13:17:00 CDT 2003
-2.27_01 Sun Mar 23 19:46:00 CDT 2003
- - Handed over to Andy Lester for further maintenance.
- - Fixed when the path to perl contains spaces on Windows
- * Stas Bekman noticed that tests with no output at all were
- interpreted as passing
- - MacPerl test tweak for busted exit codes (bleadperl 17345)
- - Abigail and Nick Clark both hit the 100000 "huge test that will
- suck up all your memory" limit with legit tests. Made the check
- smarter to allow large, planned tests to work.
- - Partial fix of stats display when a test fails only because there's
- too many tests.
- - Made wait.ph and WCOREDUMP anti-vommit protection more robust in
- cases where wait.ph loads but WCOREDUMP() pukes when run.
- - Added a LICENSE.
- - Ilya noticed the per test skip reason was accumlating between tests.
-
-2.26 Wed Jun 19 16:58:02 EDT 2002
- - Workaround for MacPerl's lack of a working putenv. It will never
- see the PERL5LIB environment variable (perl@16942).
-
-2.25 Sun Jun 16 03:00:33 EDT 2002
- - $Strap is now a global to allow Test::Harness::Straps
- experimentation.
- - Little spelling nit in a diagnostic.
- - Chris Richmond noted that the runtests() docs were wrong. It will
- die, not return false, when any tests fail. This is silly, but
- historically necessary for 'make test'. Docs corrected.
- - MacPerl test fixes from Pudge. (mutation of bleadperl@16989)
- - Undef warning introduced in 2.24 on skipped tests with no reasons
- fixed.
- * Test::Harness now depends on File::Spec
-
-2.24 Wed May 29 19:02:18 EDT 2002
- * Nikola Knezevic found a bug when tests are completely skipped
- but no reason is given it was considered a failure.
- * Made Test::Harness::Straps->analyze_file & Test::Harness a bit
- more graceful when the test doesn't exist.
-
-2.23 Wed May 22 12:59:47 EDT 2002
- - reason for all skip wasn't being displayed. Broken in 2.20.
- - Changed the wait status tests to conform with POSIX standards.
- - Quieted some SYSTEM$ABORT noise leaking out from dying test tests
- on VMS.
-
-2.22 Fri May 17 19:01:35 EDT 2002
- - Fixed parsing of #!/usr/bin/perl-current to not see a -t.
- (RT #574)
- - Fixed exit codes on MPE/iX
-
-2.21 Mon May 6 00:43:22 EDT 2002
- - removed a bunch of dead code left over after 2.20's gutting.
- - The fix for the $^X "bug" added in 2.02 has been removed. It
- caused more trouble than the old bug (I'd never seen a problem
- before anyway)
- - 2.20 broke $verbose
-
-2.20 Sat May 4 22:31:20 EDT 2002
- * An almost complete conversion of the Test::Harness test parsing
- to use Test::Harness::Straps.
-
-2.04 Tue Apr 30 00:54:49 EDT 2002
- * Changing the output format of skips
- - Taking into account VMS's special exit codes in the tests.
-
-2.03 Thu Apr 25 01:01:34 EDT 2002
- * $^X fix made safer.
- - Noise from loading wait.ph to analyze core files supressed
- - MJD found a situation where a test could run Test::Harness
- out of memory. Protecting against that specific case.
- - Made the 1..M docs a bit clearer.
- - Fixed TODO tests so Test::Harness does not display a NOK for
- them.
- - Test::Harness::Straps->analyze_file() docs were not clear as to
- its effects
-
-2.02 Thu Mar 14 18:06:04 EST 2002
- * Ken Williams fixed the long standing $^X bug.
- * Added HARNESS_VERBOSE
- * Fixed a bug where Test::Harness::Straps was considering a test that
- is ok but died as passing.
- - Added the exit and wait codes of the test to the
- analyze_file() results.
-
-2.01 Thu Dec 27 18:54:36 EST 2001
- * Added 'passing' to the results to tell you if the test passed
- * Added Test::Harness::Straps example (examples/mini_harness.plx)
- * Header-at-end tests were being interpreted as failing sometimes
- - The 'skip_all' results from analyze* was not being set
- - analyze_fh() and analyze_file() now work more efficiently, reading
- line-by-line instead of slurping as before.
-
-2.00 Sun Dec 23 19:13:57 EST 2001
- - Fixed a warning on VMS.
- - Removed a little unnecessary code from analyze_file()
- - Made sure filehandles are getting closed
- - analyze() now considers "not \nok" to be a failure (VMSism)
- but Test::Harness still doesn't.
-
-2.00_05 Mon Dec 17 22:08:02 EST 2001
- * Wasn't filtering @INC properly when a test is run with -T, caused the
- command line to be too long on VMS. VMS should be 100% now.
- - Little bug in the skip 'various reasons' logic.
- - Minor POD nit in 5.004_04
- - Little speling mistak
-
-2.00_04 Sun Dec 16 00:33:32 EST 2001
- * Major Test::Harness::Straps doc bug.
-
-2.00_03 Sat Dec 15 23:52:17 EST 2001
- * First release candidate
- * 'summary' is now 'details'
- * Test #1 is now element 0 on the details array. It works out better
- that way.
- * analyze_file() is more portable, but no longer taint clean
- * analyze_file() properly preserves @INC and handles -T switches
- - minor mistake in the test header line parsing
-
-1.26 Mon Nov 12 15:44:01 EST 2001
- * An excuse to upload a new version to CPAN to get Test::Harness
- back on the index.
-
-2.00_00 Sat Sep 29 00:12:03 EDT 2001
- * Partial gutting of the internals
- * Added Test::Harness::Straps
-
-1.25 Tue Aug 7 08:51:09 EDT 2001
- * Fixed a bug with tests failing if they're all skipped
- reported by Stas Bekman.
- - Fixed a very minor warning in 5.004_04
- - Fixed displaying filenames not from @ARGV
- - Merging with bleadperl
- - minor fixes to the filename in the report
- - '[no reason given]' skip reason
-
-1.24 Tue Aug 7 08:51:09 EDT 2001
- - Added internal information about number of todo tests
-
-1.23 Tue Jul 31 15:06:47 EDT 2001
- - Merged in Ilya's "various reasons" patch
- * Fixed "not ok 23 - some name # TODO" style tests
-
-1.22 Mon Jun 25 02:00:02 EDT 2001
- * Fixed bug with failing tests using header at end.
- - Documented how Test::Harness deals with garbage input
- - Turned on test counter mismatch warning
-
-1.21 Wed May 23 19:22:53 BST 2001
- * No longer considered unstable. Merging back with the perl core.
- - Fixed minor nit about the report summary
- - Added docs on the meaning of the failure report
- - Minor POD nits fixed mirroring perl change 9176
- - TODO and SEE ALSO expanded
-
-1.20 Wed Mar 14 23:09:20 GMT 2001 by Michael G Schwern *UNSTABLE*
- * Fixed and tested with 5.004!
- - Added EXAMPLE docs
- - Added TODO docs
- - Now uneffected by -l, $\ or $,
-
-1.19 Sat Mar 10 00:43:29 GMT 2001 by Michael G Schwern *UNSTABLE*
- - More internal reworking
- * Removed use of experimental /(?>...)/ feature for backwards compat
- * Removed use of open(my $fh, $file) for backwards compatibility
- * Removed use of Tie::StdHandle in tests for backwards compat
- * Added dire warning that this is unstable.
- - Added some tests from the old CPAN release
-
-1.18 Mon Mar 5 17:35:11 GMT 2001 by Michael G Schwern
- * Under new management!
- * Test::Harness is now being concurrently shipped on CPAN as well
- as in the core.
- - Switched "our" for "use vars" and moved the minimum version back
- to 5.004. This may be optimistic.
-
-
-*** Missing version history to be extracted from Perl changes ***
-
-
-1.07 Fri Feb 23 1996 by Andreas Koenig
- - Gisle sent me a documentation patch that showed me, that the
- unless(/^#/) is unnessessary. Applied the patch and deleted the block
- checking for "comment" lines. -- All lines are comment lines that do
- not match /^1\.\.([0-9]+)/ or /^(not\s+)?ok\b/.
- - Ilyaz request to print "ok (empty test case)" whenever we say 1..0
- implemented.
- - Harness now doesn't abort anymore if we received confused test output,
- just warns instead.
-
-1.05 Wed Jan 31 1996 by Andreas Koenig
- - More updates on docu and introduced the liberality that the script
- output may omit the test numbers.
-
-1.03 Mon January 28 1996 by Andreas Koenig
- - Added the statistics for subtests. Updated the documentation.
-
-1.02 by Andreas Koenig
- - This version reports a list of the tests that failed accompanied by
- some trivial statistics. The older (unnumbered) version stopped
- processing after the first failed test.
- - Additionally it reports the exit status if there is one.
-
-
diff -urN Test.old/Harness/Iterator.pm Test/Harness/Iterator.pm
--- perl-5.10.0/lib/Test.old/Harness/Iterator.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Iterator.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,70 +0,0 @@
-package Test::Harness::Iterator;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = 0.02;
-
-=head1 NAME
-
-Test::Harness::Iterator - Internal Test::Harness Iterator
-
-=head1 SYNOPSIS
-
- use Test::Harness::Iterator;
- my $it = Test::Harness::Iterator->new(\*TEST);
- my $it = Test::Harness::Iterator->new(\@array);
-
- my $line = $it->next;
-
-=head1 DESCRIPTION
-
-B<FOR INTERNAL USE ONLY!>
-
-This is a simple iterator wrapper for arrays and filehandles.
-
-=head2 new()
-
-Create an iterator.
-
-=head2 next()
-
-Iterate through it, of course.
-
-=cut
-
-sub new {
- my($proto, $thing) = @_;
-
- my $self = {};
- if( ref $thing eq 'GLOB' ) {
- bless $self, 'Test::Harness::Iterator::FH';
- $self->{fh} = $thing;
- }
- elsif( ref $thing eq 'ARRAY' ) {
- bless $self, 'Test::Harness::Iterator::ARRAY';
- $self->{idx} = 0;
- $self->{array} = $thing;
- }
- else {
- warn "Can't iterate with a ", ref $thing;
- }
-
- return $self;
-}
-
-package Test::Harness::Iterator::FH;
-sub next {
- my $fh = $_[0]->{fh};
-
- # readline() doesn't work so good on 5.5.4.
- return scalar <$fh>;
-}
-
-
-package Test::Harness::Iterator::ARRAY;
-sub next {
- my $self = shift;
- return $self->{array}->[$self->{idx}++];
-}
-
-"Steve Peters, Master Of True Value Finding, was here.";
diff -urN Test.old/Harness/Point.pm Test/Harness/Point.pm
--- perl-5.10.0/lib/Test.old/Harness/Point.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Point.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,143 +0,0 @@
-# -*- Mode: cperl; cperl-indent-level: 4 -*-
-package Test::Harness::Point;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = '0.01';
-
-=head1 NAME
-
-Test::Harness::Point - object for tracking a single test point
-
-=head1 SYNOPSIS
-
-One Test::Harness::Point object represents a single test point.
-
-=head1 CONSTRUCTION
-
-=head2 new()
-
- my $point = new Test::Harness::Point;
-
-Create a test point object.
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
-
- return $self;
-}
-
-=head1 from_test_line( $line )
-
-Constructor from a TAP test line, or empty return if the test line
-is not a test line.
-
-=cut
-
-sub from_test_line {
- my $class = shift;
- my $line = shift or return;
-
- # We pulverize the line down into pieces in three parts.
- my ($not, $number, $extra) = ($line =~ /^(not )?ok\b(?:\s+(\d+))?\s*(.*)/) or return;
-
- my $point = $class->new;
- $point->set_number( $number );
- $point->set_ok( !$not );
-
- if ( $extra ) {
- my ($description,$directive) = split( /(?:[^\\]|^)#/, $extra, 2 );
- $description =~ s/^- //; # Test::More puts it in there
- $point->set_description( $description );
- if ( $directive ) {
- $point->set_directive( $directive );
- }
- } # if $extra
-
- return $point;
-} # from_test_line()
-
-=head1 ACCESSORS
-
-Each of the following fields has a getter and setter method.
-
-=over 4
-
-=item * ok
-
-=item * number
-
-=cut
-
-sub ok { my $self = shift; $self->{ok} }
-sub set_ok {
- my $self = shift;
- my $ok = shift;
- $self->{ok} = $ok ? 1 : 0;
-}
-sub pass {
- my $self = shift;
-
- return ($self->ok || $self->is_todo || $self->is_skip) ? 1 : 0;
-}
-
-sub number { my $self = shift; $self->{number} }
-sub set_number { my $self = shift; $self->{number} = shift }
-
-sub description { my $self = shift; $self->{description} }
-sub set_description {
- my $self = shift;
- $self->{description} = shift;
- $self->{name} = $self->{description}; # history
-}
-
-sub directive { my $self = shift; $self->{directive} }
-sub set_directive {
- my $self = shift;
- my $directive = shift;
-
- $directive =~ s/^\s+//;
- $directive =~ s/\s+$//;
- $self->{directive} = $directive;
-
- my ($type,$reason) = ($directive =~ /^\s*(\S+)(?:\s+(.*))?$/);
- $self->set_directive_type( $type );
- $reason = "" unless defined $reason;
- $self->{directive_reason} = $reason;
-}
-sub set_directive_type {
- my $self = shift;
- $self->{directive_type} = lc shift;
- $self->{type} = $self->{directive_type}; # History
-}
-sub set_directive_reason {
- my $self = shift;
- $self->{directive_reason} = shift;
-}
-sub directive_type { my $self = shift; $self->{directive_type} }
-sub type { my $self = shift; $self->{directive_type} }
-sub directive_reason{ my $self = shift; $self->{directive_reason} }
-sub reason { my $self = shift; $self->{directive_reason} }
-sub is_todo {
- my $self = shift;
- my $type = $self->directive_type;
- return $type && ( $type eq 'todo' );
-}
-sub is_skip {
- my $self = shift;
- my $type = $self->directive_type;
- return $type && ( $type eq 'skip' );
-}
-
-sub diagnostics {
- my $self = shift;
- return @{$self->{diagnostics}} if wantarray;
- return join( "\n", @{$self->{diagnostics}} );
-}
-sub add_diagnostic { my $self = shift; push @{$self->{diagnostics}}, @_ }
-
-
-1;
diff -urN Test.old/Harness/Results.pm Test/Harness/Results.pm
--- perl-5.10.0/lib/Test.old/Harness/Results.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Results.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,182 +0,0 @@
-# -*- Mode: cperl; cperl-indent-level: 4 -*-
-package Test::Harness::Results;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = '0.01';
-
-=head1 NAME
-
-Test::Harness::Results - object for tracking results from a single test file
-
-=head1 SYNOPSIS
-
-One Test::Harness::Results object represents the results from one
-test file getting analyzed.
-
-=head1 CONSTRUCTION
-
-=head2 new()
-
- my $results = new Test::Harness::Results;
-
-Create a test point object. Typically, however, you'll not create
-one yourself, but access a Results object returned to you by
-Test::Harness::Results.
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
-
- return $self;
-}
-
-=head1 ACCESSORS
-
-The following data points are defined:
-
- passing true if the whole test is considered a pass
- (or skipped), false if its a failure
-
- exit the exit code of the test run, if from a file
- wait the wait code of the test run, if from a file
-
- max total tests which should have been run
- seen total tests actually seen
- skip_all if the whole test was skipped, this will
- contain the reason.
-
- ok number of tests which passed
- (including todo and skips)
-
- todo number of todo tests seen
- bonus number of todo tests which
- unexpectedly passed
-
- skip number of tests skipped
-
-So a successful test should have max == seen == ok.
-
-
-There is one final item, the details.
-
- details an array ref reporting the result of
- each test looks like this:
-
- $results{details}[$test_num - 1] =
- { ok => is the test considered ok?
- actual_ok => did it literally say 'ok'?
- name => name of the test (if any)
- diagnostics => test diagnostics (if any)
- type => 'skip' or 'todo' (if any)
- reason => reason for the above (if any)
- };
-
-Element 0 of the details is test #1. I tried it with element 1 being
-#1 and 0 being empty, this is less awkward.
-
-
-Each of the following fields has a getter and setter method.
-
-=over 4
-
-=item * wait
-
-=item * exit
-
-=cut
-
-sub set_wait { my $self = shift; $self->{wait} = shift }
-sub wait {
- my $self = shift;
- return $self->{wait} || 0;
-}
-
-sub set_skip_all { my $self = shift; $self->{skip_all} = shift }
-sub skip_all {
- my $self = shift;
- return $self->{skip_all};
-}
-
-sub inc_max { my $self = shift; $self->{max} += (@_ ? shift : 1) }
-sub max {
- my $self = shift;
- return $self->{max} || 0;
-}
-
-sub set_passing { my $self = shift; $self->{passing} = shift }
-sub passing {
- my $self = shift;
- return $self->{passing} || 0;
-}
-
-sub inc_ok { my $self = shift; $self->{ok} += (@_ ? shift : 1) }
-sub ok {
- my $self = shift;
- return $self->{ok} || 0;
-}
-
-sub set_exit {
- my $self = shift;
- if ($^O eq 'VMS') {
- eval {
- use vmsish q(status);
- $self->{exit} = shift; # must be in same scope as pragma
- }
- }
- else {
- $self->{exit} = shift;
- }
-}
-sub exit {
- my $self = shift;
- return $self->{exit} || 0;
-}
-
-sub inc_bonus { my $self = shift; $self->{bonus}++ }
-sub bonus {
- my $self = shift;
- return $self->{bonus} || 0;
-}
-
-sub set_skip_reason { my $self = shift; $self->{skip_reason} = shift }
-sub skip_reason {
- my $self = shift;
- return $self->{skip_reason} || 0;
-}
-
-sub inc_skip { my $self = shift; $self->{skip}++ }
-sub skip {
- my $self = shift;
- return $self->{skip} || 0;
-}
-
-sub inc_todo { my $self = shift; $self->{todo}++ }
-sub todo {
- my $self = shift;
- return $self->{todo} || 0;
-}
-
-sub inc_seen { my $self = shift; $self->{seen}++ }
-sub seen {
- my $self = shift;
- return $self->{seen} || 0;
-}
-
-sub set_details {
- my $self = shift;
- my $index = shift;
- my $details = shift;
-
- my $array = ($self->{details} ||= []);
- $array->[$index-1] = $details;
-}
-
-sub details {
- my $self = shift;
- return $self->{details} || [];
-}
-
-1;
diff -urN Test.old/Harness/Straps.pm Test/Harness/Straps.pm
--- perl-5.10.0/lib/Test.old/Harness/Straps.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Straps.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,648 +0,0 @@
-# -*- Mode: cperl; cperl-indent-level: 4 -*-
-package Test::Harness::Straps;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = '0.26_01';
-
-use Config;
-use Test::Harness::Assert;
-use Test::Harness::Iterator;
-use Test::Harness::Point;
-use Test::Harness::Results;
-
-# Flags used as return values from our methods. Just for internal
-# clarification.
-my $YES = (1==1);
-my $NO = !$YES;
-
-=head1 NAME
-
-Test::Harness::Straps - detailed analysis of test results
-
-=head1 SYNOPSIS
-
- use Test::Harness::Straps;
-
- my $strap = Test::Harness::Straps->new;
-
- # Various ways to interpret a test
- my $results = $strap->analyze($name, \@test_output);
- my $results = $strap->analyze_fh($name, $test_filehandle);
- my $results = $strap->analyze_file($test_file);
-
- # UNIMPLEMENTED
- my %total = $strap->total_results;
-
- # Altering the behavior of the strap UNIMPLEMENTED
- my $verbose_output = $strap->dump_verbose();
- $strap->dump_verbose_fh($output_filehandle);
-
-
-=head1 DESCRIPTION
-
-B<THIS IS ALPHA SOFTWARE> in that the interface is subject to change
-in incompatible ways. It is otherwise stable.
-
-Test::Harness is limited to printing out its results. This makes
-analysis of the test results difficult for anything but a human. To
-make it easier for programs to work with test results, we provide
-Test::Harness::Straps. Instead of printing the results, straps
-provide them as raw data. You can also configure how the tests are to
-be run.
-
-The interface is currently incomplete. I<Please> contact the author
-if you'd like a feature added or something change or just have
-comments.
-
-=head1 CONSTRUCTION
-
-=head2 new()
-
- my $strap = Test::Harness::Straps->new;
-
-Initialize a new strap.
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
-
- $self->_init;
-
- return $self;
-}
-
-=for private $strap->_init
-
- $strap->_init;
-
-Initialize the internal state of a strap to make it ready for parsing.
-
-=cut
-
-sub _init {
- my($self) = shift;
-
- $self->{_is_vms} = ( $^O eq 'VMS' );
- $self->{_is_win32} = ( $^O =~ /^(MS)?Win32$/ );
- $self->{_is_macos} = ( $^O eq 'MacOS' );
-}
-
-=head1 ANALYSIS
-
-=head2 $strap->analyze( $name, \@output_lines )
-
- my $results = $strap->analyze($name, \@test_output);
-
-Analyzes the output of a single test, assigning it the given C<$name>
-for use in the total report. Returns the C<$results> of the test.
-See L<Results>.
-
-C<@test_output> should be the raw output from the test, including
-newlines.
-
-=cut
-
-sub analyze {
- my($self, $name, $test_output) = @_;
-
- my $it = Test::Harness::Iterator->new($test_output);
- return $self->_analyze_iterator($name, $it);
-}
-
-
-sub _analyze_iterator {
- my($self, $name, $it) = @_;
-
- $self->_reset_file_state;
- $self->{file} = $name;
-
- my $results = Test::Harness::Results->new;
-
- # Set them up here so callbacks can have them.
- $self->{totals}{$name} = $results;
- while( defined(my $line = $it->next) ) {
- $self->_analyze_line($line, $results);
- last if $self->{saw_bailout};
- }
-
- $results->set_skip_all( $self->{skip_all} ) if defined $self->{skip_all};
-
- my $passed =
- (($results->max == 0) && defined $results->skip_all) ||
- ($results->max &&
- $results->seen &&
- $results->max == $results->seen &&
- $results->max == $results->ok);
-
- $results->set_passing( $passed ? 1 : 0 );
-
- return $results;
-}
-
-
-sub _analyze_line {
- my $self = shift;
- my $line = shift;
- my $results = shift;
-
- $self->{line}++;
-
- my $linetype;
- my $point = Test::Harness::Point->from_test_line( $line );
- if ( $point ) {
- $linetype = 'test';
-
- $results->inc_seen;
- $point->set_number( $self->{'next'} ) unless $point->number;
-
- # sometimes the 'not ' and the 'ok' are on different lines,
- # happens often on VMS if you do:
- # print "not " unless $test;
- # print "ok $num\n";
- if ( $self->{lone_not_line} && ($self->{lone_not_line} == $self->{line} - 1) ) {
- $point->set_ok( 0 );
- }
-
- if ( $self->{todo}{$point->number} ) {
- $point->set_directive_type( 'todo' );
- }
-
- if ( $point->is_todo ) {
- $results->inc_todo;
- $results->inc_bonus if $point->ok;
- }
- elsif ( $point->is_skip ) {
- $results->inc_skip;
- }
-
- $results->inc_ok if $point->pass;
-
- if ( ($point->number > 100_000) && ($point->number > ($self->{max}||100_000)) ) {
- if ( !$self->{too_many_tests}++ ) {
- warn "Enormous test number seen [test ", $point->number, "]\n";
- warn "Can't detailize, too big.\n";
- }
- }
- else {
- my $details = {
- ok => $point->pass,
- actual_ok => $point->ok,
- name => _def_or_blank( $point->description ),
- type => _def_or_blank( $point->directive_type ),
- reason => _def_or_blank( $point->directive_reason ),
- };
-
- assert( defined( $details->{ok} ) && defined( $details->{actual_ok} ) );
- $results->set_details( $point->number, $details );
- }
- } # test point
- elsif ( $line =~ /^not\s+$/ ) {
- $linetype = 'other';
- # Sometimes the "not " and "ok" will be on separate lines on VMS.
- # We catch this and remember we saw it.
- $self->{lone_not_line} = $self->{line};
- }
- elsif ( $self->_is_header($line) ) {
- $linetype = 'header';
-
- $self->{saw_header}++;
-
- $results->inc_max( $self->{max} );
- }
- elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) {
- $linetype = 'bailout';
- $self->{saw_bailout} = 1;
- }
- elsif (my $diagnostics = $self->_is_diagnostic_line( $line )) {
- $linetype = 'other';
- # XXX We can throw this away, really.
- my $test = $results->details->[-1];
- $test->{diagnostics} ||= '';
- $test->{diagnostics} .= $diagnostics;
- }
- else {
- $linetype = 'other';
- }
-
- $self->callback->($self, $line, $linetype, $results) if $self->callback;
-
- $self->{'next'} = $point->number + 1 if $point;
-} # _analyze_line
-
-
-sub _is_diagnostic_line {
- my ($self, $line) = @_;
- return if index( $line, '# Looks like you failed' ) == 0;
- $line =~ s/^#\s//;
- return $line;
-}
-
-=for private $strap->analyze_fh( $name, $test_filehandle )
-
- my $results = $strap->analyze_fh($name, $test_filehandle);
-
-Like C<analyze>, but it reads from the given filehandle.
-
-=cut
-
-sub analyze_fh {
- my($self, $name, $fh) = @_;
-
- my $it = Test::Harness::Iterator->new($fh);
- return $self->_analyze_iterator($name, $it);
-}
-
-=head2 $strap->analyze_file( $test_file )
-
- my $results = $strap->analyze_file($test_file);
-
-Like C<analyze>, but it runs the given C<$test_file> and parses its
-results. It will also use that name for the total report.
-
-=cut
-
-sub analyze_file {
- my($self, $file) = @_;
-
- unless( -e $file ) {
- $self->{error} = "$file does not exist";
- return;
- }
-
- unless( -r $file ) {
- $self->{error} = "$file is not readable";
- return;
- }
-
- local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
- if ( $Test::Harness::Debug ) {
- local $^W=0; # ignore undef warnings
- print "# PERL5LIB=$ENV{PERL5LIB}\n";
- }
-
- # *sigh* this breaks under taint, but open -| is unportable.
- my $line = $self->_command_line($file);
-
- unless ( open(FILE, "$line|" )) {
- print "can't run $file. $!\n";
- return;
- }
-
- my $results = $self->analyze_fh($file, \*FILE);
- my $exit = close FILE;
-
- $results->set_wait($?);
- if ( $? && $self->{_is_vms} ) {
- $results->set_exit($?);
- }
- else {
- $results->set_exit( _wait2exit($?) );
- }
- $results->set_passing(0) unless $? == 0;
-
- $self->_restore_PERL5LIB();
-
- return $results;
-}
-
-
-eval { require POSIX; &POSIX::WEXITSTATUS(0) };
-if( $@ ) {
- *_wait2exit = sub { $_[0] >> 8 };
-}
-else {
- *_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) }
-}
-
-=for private $strap->_command_line( $file )
-
-Returns the full command line that will be run to test I<$file>.
-
-=cut
-
-sub _command_line {
- my $self = shift;
- my $file = shift;
-
- my $command = $self->_command();
- my $switches = $self->_switches($file);
-
- $file = qq["$file"] if ($file =~ /\s/) && ($file !~ /^".*"$/);
- my $line = "$command $switches $file";
-
- return $line;
-}
-
-
-=for private $strap->_command()
-
-Returns the command that runs the test. Combine this with C<_switches()>
-to build a command line.
-
-Typically this is C<$^X>, but you can set C<$ENV{HARNESS_PERL}>
-to use a different Perl than what you're running the harness under.
-This might be to run a threaded Perl, for example.
-
-You can also overload this method if you've built your own strap subclass,
-such as a PHP interpreter for a PHP-based strap.
-
-=cut
-
-sub _command {
- my $self = shift;
-
- return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
- #return qq["$^X"] if $self->{_is_win32} && ($^X =~ /[^\w\.\/\\]/);
- return qq["$^X"] if $^X =~ /\s/ and $^X !~ /^["']/;
- return $^X;
-}
-
-
-=for private $strap->_switches( $file )
-
-Formats and returns the switches necessary to run the test.
-
-=cut
-
-sub _switches {
- my($self, $file) = @_;
-
- my @existing_switches = $self->_cleaned_switches( $Test::Harness::Switches, $ENV{HARNESS_PERL_SWITCHES} );
- my @derived_switches;
-
- local *TEST;
- open(TEST, $file) or print "can't open $file. $!\n";
- my $shebang = <TEST>;
- close(TEST) or print "can't close $file. $!\n";
-
- my $taint = ( $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ );
- push( @derived_switches, "-$1" ) if $taint;
-
- # When taint mode is on, PERL5LIB is ignored. So we need to put
- # all that on the command line as -Is.
- # MacPerl's putenv is broken, so it will not see PERL5LIB, tainted or not.
- if ( $taint || $self->{_is_macos} ) {
- my @inc = $self->_filtered_INC;
- push @derived_switches, map { "-I$_" } @inc;
- }
-
- # Quote the argument if there's any whitespace in it, or if
- # we're VMS, since VMS requires all parms quoted. Also, don't quote
- # it if it's already quoted.
- for ( @derived_switches ) {
- $_ = qq["$_"] if ((/\s/ || $self->{_is_vms}) && !/^".*"$/ );
- }
- return join( " ", @existing_switches, @derived_switches );
-}
-
-=for private $strap->_cleaned_switches( @switches_from_user )
-
-Returns only defined, non-blank, trimmed switches from the parms passed.
-
-=cut
-
-sub _cleaned_switches {
- my $self = shift;
-
- local $_;
-
- my @switches;
- for ( @_ ) {
- my $switch = $_;
- next unless defined $switch;
- $switch =~ s/^\s+//;
- $switch =~ s/\s+$//;
- push( @switches, $switch ) if $switch ne "";
- }
-
- return @switches;
-}
-
-=for private $strap->_INC2PERL5LIB
-
- local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
-
-Takes the current value of C<@INC> and turns it into something suitable
-for putting onto C<PERL5LIB>.
-
-=cut
-
-sub _INC2PERL5LIB {
- my($self) = shift;
-
- $self->{_old5lib} = $ENV{PERL5LIB};
-
- return join $Config{path_sep}, $self->_filtered_INC;
-}
-
-=for private $strap->_filtered_INC()
-
- my @filtered_inc = $self->_filtered_INC;
-
-Shortens C<@INC> by removing redundant and unnecessary entries.
-Necessary for OSes with limited command line lengths, like VMS.
-
-=cut
-
-sub _filtered_INC {
- my($self, @inc) = @_;
- @inc = @INC unless @inc;
-
- if( $self->{_is_vms} ) {
- # VMS has a 255-byte limit on the length of %ENV entries, so
- # toss the ones that involve perl_root, the install location
- @inc = grep !/perl_root/i, @inc;
-
- }
- elsif ( $self->{_is_win32} ) {
- # Lose any trailing backslashes in the Win32 paths
- s/[\\\/+]$// foreach @inc;
- }
-
- my %seen;
- $seen{$_}++ foreach $self->_default_inc();
- @inc = grep !$seen{$_}++, @inc;
-
- return @inc;
-}
-
-
-{ # Without caching, _default_inc() takes a huge amount of time
- my %cache;
- sub _default_inc {
- my $self = shift;
- my $perl = $self->_command;
- $cache{$perl} ||= [do {
- local $ENV{PERL5LIB};
- my @inc =`$perl -le "print join qq[\\n], \@INC"`;
- chomp @inc;
- }];
- return @{$cache{$perl}};
- }
-}
-
-
-=for private $strap->_restore_PERL5LIB()
-
- $self->_restore_PERL5LIB;
-
-This restores the original value of the C<PERL5LIB> environment variable.
-Necessary on VMS, otherwise a no-op.
-
-=cut
-
-sub _restore_PERL5LIB {
- my($self) = shift;
-
- return unless $self->{_is_vms};
-
- if (defined $self->{_old5lib}) {
- $ENV{PERL5LIB} = $self->{_old5lib};
- }
-}
-
-=head1 Parsing
-
-Methods for identifying what sort of line you're looking at.
-
-=for private _is_diagnostic
-
- my $is_diagnostic = $strap->_is_diagnostic($line, \$comment);
-
-Checks if the given line is a comment. If so, it will place it into
-C<$comment> (sans #).
-
-=cut
-
-sub _is_diagnostic {
- my($self, $line, $comment) = @_;
-
- if( $line =~ /^\s*\#(.*)/ ) {
- $$comment = $1;
- return $YES;
- }
- else {
- return $NO;
- }
-}
-
-=for private _is_header
-
- my $is_header = $strap->_is_header($line);
-
-Checks if the given line is a header (1..M) line. If so, it places how
-many tests there will be in C<< $strap->{max} >>, a list of which tests
-are todo in C<< $strap->{todo} >> and if the whole test was skipped
-C<< $strap->{skip_all} >> contains the reason.
-
-=cut
-
-# Regex for parsing a header. Will be run with /x
-my $Extra_Header_Re = <<'REGEX';
- ^
- (?: \s+ todo \s+ ([\d \t]+) )? # optional todo set
- (?: \s* \# \s* ([\w:]+\s?) (.*) )? # optional skip with optional reason
-REGEX
-
-sub _is_header {
- my($self, $line) = @_;
-
- if( my($max, $extra) = $line =~ /^1\.\.(\d+)(.*)/ ) {
- $self->{max} = $max;
- assert( $self->{max} >= 0, 'Max # of tests looks right' );
-
- if( defined $extra ) {
- my($todo, $skip, $reason) = $extra =~ /$Extra_Header_Re/xo;
-
- $self->{todo} = { map { $_ => 1 } split /\s+/, $todo } if $todo;
-
- if( $self->{max} == 0 ) {
- $reason = '' unless defined $skip and $skip =~ /^Skip/i;
- }
-
- $self->{skip_all} = $reason;
- }
-
- return $YES;
- }
- else {
- return $NO;
- }
-}
-
-=for private _is_bail_out
-
- my $is_bail_out = $strap->_is_bail_out($line, \$reason);
-
-Checks if the line is a "Bail out!". Places the reason for bailing
-(if any) in $reason.
-
-=cut
-
-sub _is_bail_out {
- my($self, $line, $reason) = @_;
-
- if( $line =~ /^Bail out!\s*(.*)/i ) {
- $$reason = $1 if $1;
- return $YES;
- }
- else {
- return $NO;
- }
-}
-
-=for private _reset_file_state
-
- $strap->_reset_file_state;
-
-Resets things like C<< $strap->{max} >> , C<< $strap->{skip_all} >>,
-etc. so it's ready to parse the next file.
-
-=cut
-
-sub _reset_file_state {
- my($self) = shift;
-
- delete @{$self}{qw(max skip_all todo too_many_tests)};
- $self->{line} = 0;
- $self->{saw_header} = 0;
- $self->{saw_bailout}= 0;
- $self->{lone_not_line} = 0;
- $self->{bailout_reason} = '';
- $self->{'next'} = 1;
-}
-
-=head1 EXAMPLES
-
-See F<examples/mini_harness.plx> for an example of use.
-
-=head1 AUTHOR
-
-Michael G Schwern C<< <schwern at pobox.com> >>, currently maintained by
-Andy Lester C<< <andy at petdance.com> >>.
-
-=head1 SEE ALSO
-
-L<Test::Harness>
-
-=cut
-
-sub _def_or_blank {
- return $_[0] if defined $_[0];
- return "";
-}
-
-sub set_callback {
- my $self = shift;
- $self->{callback} = shift;
-}
-
-sub callback {
- my $self = shift;
- return $self->{callback};
-}
-
-1;
diff -urN Test.old/Harness/t/00compile.t Test/Harness/t/00compile.t
--- perl-5.10.0/lib/Test.old/Harness/t/00compile.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/00compile.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,32 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if($ENV{PERL_CORE}) {
- chdir 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More tests => 8;
-
-BEGIN { use_ok 'Test::Harness' }
-BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION under Perl $] and Test::More $Test::More::VERSION" ) unless $ENV{PERL_CORE}}
-
-BEGIN { use_ok 'Test::Harness::Straps' }
-
-BEGIN { use_ok 'Test::Harness::Iterator' }
-
-BEGIN { use_ok 'Test::Harness::Assert' }
-
-BEGIN { use_ok 'Test::Harness::Point' }
-
-BEGIN { use_ok 'Test::Harness::Results' }
-
-BEGIN { use_ok 'Test::Harness::Util' }
-
-# If the $VERSION is set improperly, this will spew big warnings.
-BEGIN { use_ok 'Test::Harness', 1.1601 }
-
diff -urN Test.old/Harness/t/assert.t Test/Harness/t/assert.t
--- perl-5.10.0/lib/Test.old/Harness/t/assert.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/assert.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,28 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 7;
-
-BEGIN { use_ok( 'Test::Harness::Assert' ); }
-
-
-ok( defined &assert, 'assert() exported' );
-
-ok( !eval { assert( 0 ); 1 }, 'assert( FALSE ) causes death' );
-like( $@, '/Assert failed/', ' with the right message' );
-
-ok( eval { assert( 1 ); 1 }, 'assert( TRUE ) does nothing' );
-
-ok( !eval { assert( 0, 'some name' ); 1 }, 'assert( FALSE, NAME )' );
-like( $@, '/some name/', ' has the name' );
diff -urN Test.old/Harness/t/base.t Test/Harness/t/base.t
--- perl-5.10.0/lib/Test.old/Harness/t/base.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/base.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,15 +0,0 @@
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = '../lib';
- }
-}
-
-
-print "1..1\n";
-
-unless (eval 'require Test::Harness') {
- print "not ok 1\n";
-} else {
- print "ok 1\n";
-}
diff -urN Test.old/Harness/t/callback.t Test/Harness/t/callback.t
--- perl-5.10.0/lib/Test.old/Harness/t/callback.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/callback.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,69 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More;
-use File::Spec;
-
-BEGIN {
- use vars qw( %samples );
-
- %samples = (
- bailout => [qw( header test test test bailout )],
- combined => ['header', ('test') x 10],
- descriptive => ['header', ('test') x 5 ],
- duplicates => ['header', ('test') x 11 ],
- head_end => [qw( other test test test test
- other header other other )],
- head_fail => [qw( other test test test test
- other header other other )],
- no_nums => ['header', ('test') x 5 ],
- out_of_order=> [('test') x 10, 'header', ('test') x 5],
- simple => [qw( header test test test test test )],
- simple_fail => [qw( header test test test test test )],
- 'skip' => [qw( header test test test test test )],
- skipall => [qw( header )],
- skipall_nomsg => [qw( header )],
- skip_nomsg => [qw( header test )],
- taint => [qw( header test )],
- 'todo' => [qw( header test test test test test )],
- todo_inline => [qw( header test test test )],
- vms_nit => [qw( header other test test )],
- with_comments => [qw( other header other test other test test
- test other other test other )],
- );
- plan tests => 2 + scalar keys %samples;
-}
-
-BEGIN { use_ok( 'Test::Harness::Straps' ); }
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps' );
-$strap->set_callback(
- sub {
- my($self, $line, $type, $totals) = @_;
- push @out, $type;
- }
-);
-
-for my $test ( sort keys %samples ) {
- my $expect = $samples{$test};
-
- local @out = ();
- $strap->analyze_file(File::Spec->catfile($SAMPLE_TESTS, $test));
-
- is_deeply(\@out, $expect, "$test callback");
-}
diff -urN Test.old/Harness/t/failure.t Test/Harness/t/failure.t
--- perl-5.10.0/lib/Test.old/Harness/t/failure.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/failure.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,53 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if ($^O eq 'VMS') {
- print '1..0 # Child test output confuses parent test counter';
- exit;
- }
-}
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 6;
-use File::Spec;
-
-BEGIN {
- use_ok( 'Test::Harness' );
-}
-
-my $died;
-sub prepare_for_death { $died = 0; }
-sub signal_death { $died = 1; }
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-PASSING: {
- local $SIG{__DIE__} = \&signal_death;
- prepare_for_death();
- eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "simple" ) ) };
- ok( !$@, "simple lives" );
- is( $died, 0, "Death never happened" );
-}
-
-FAILING: {
- local $SIG{__DIE__} = \&signal_death;
- prepare_for_death();
- eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "too_many" ) ) };
- ok( $@, "$@" );
- ok( $@ =~ m[Failed 1/1], "too_many dies" );
- is( $died, 1, "Death happened" );
-}
diff -urN Test.old/Harness/t/from_line.t Test/Harness/t/from_line.t
--- perl-5.10.0/lib/Test.old/Harness/t/from_line.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/from_line.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,64 +0,0 @@
-#!perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 23;
-
-BEGIN {
- use_ok( 'Test::Harness::Point' );
-}
-
-BASIC_OK: {
- my $line = "ok 14 - Blah blah";
- my $point = Test::Harness::Point->from_test_line( $line );
- isa_ok( $point, 'Test::Harness::Point', 'BASIC_OK' );
- is( $point->number, 14 );
- ok( $point->ok );
- is( $point->description, 'Blah blah' );
-}
-
-BASIC_NOT_OK: {
- my $line = "not ok 267 Yada";
- my $point = Test::Harness::Point->from_test_line( $line );
- isa_ok( $point, 'Test::Harness::Point', 'BASIC_NOT_OK' );
- is( $point->number, 267 );
- ok( !$point->ok );
- is( $point->description, 'Yada' );
-}
-
-CRAP: {
- my $point = Test::Harness::Point->from_test_line( 'ok14 - Blah' );
- ok( !defined $point, 'CRAP 1' );
-
- $point = Test::Harness::Point->from_test_line( 'notok 14' );
- ok( !defined $point, 'CRAP 2' );
-}
-
-PARSE_TODO: {
- my $point = Test::Harness::Point->from_test_line( 'not ok 14 - Calculate sqrt(-1) # TODO Still too rational' );
- isa_ok( $point, 'Test::Harness::Point', 'PARSE_TODO' );
- is( $point->description, 'Calculate sqrt(-1)' );
- is( $point->directive_type, 'todo' );
- is( $point->directive_reason, 'Still too rational' );
- ok( !$point->is_skip );
- ok( $point->is_todo );
-}
-
-PARSE_SKIP: {
- my $point = Test::Harness::Point->from_test_line( 'ok 14 # skip Not on bucket #6' );
- isa_ok( $point, 'Test::Harness::Point', 'PARSE_SKIP' );
- is( $point->description, '' );
- is( $point->directive_type, 'skip' );
- is( $point->directive_reason, 'Not on bucket #6' );
- ok( $point->is_skip );
- ok( !$point->is_todo );
-}
diff -urN Test.old/Harness/t/harness.t Test/Harness/t/harness.t
--- perl-5.10.0/lib/Test.old/Harness/t/harness.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/harness.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,22 +0,0 @@
-#!/usr/bin/perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 2;
-
-BEGIN {
- use_ok( 'Test::Harness' );
-}
-
-my $strap = Test::Harness->strap;
-isa_ok( $strap, 'Test::Harness::Straps' );
diff -urN Test.old/Harness/t/inc_taint.t Test/Harness/t/inc_taint.t
--- perl-5.10.0/lib/Test.old/Harness/t/inc_taint.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/inc_taint.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,26 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::Harness;
-use Test::More tests => 1;
-use Dev::Null;
-
-push @INC, 'we_added_this_lib';
-
-tie *NULL, 'Dev::Null' or die $!;
-select NULL;
-my($tot, $failed) = Test::Harness::execute_tests(
- tests => [ $ENV{PERL_CORE} ? 'lib/sample-tests/inc_taint' : 't/sample-tests/inc_taint' ]
-);
-select STDOUT;
-
-ok( Test::Harness::_all_ok($tot), 'tests with taint on preserve @INC' );
diff -urN Test.old/Harness/t/nonumbers.t Test/Harness/t/nonumbers.t
--- perl-5.10.0/lib/Test.old/Harness/t/nonumbers.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/nonumbers.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,14 +0,0 @@
-if( $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE} ) {
- print "1..0 # Skip: t/TEST needs numbers\n";
- exit;
-}
-
-print <<END;
-1..6
-ok
-ok
-ok
-ok
-ok
-ok
-END
diff -urN Test.old/Harness/t/ok.t Test/Harness/t/ok.t
--- perl-5.10.0/lib/Test.old/Harness/t/ok.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/ok.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,8 +0,0 @@
--f "core" and unlink "core";
-print <<END;
-1..4
-ok 1
-ok 2
-ok 3
-ok 4
-END
diff -urN Test.old/Harness/t/point-parse.t Test/Harness/t/point-parse.t
--- perl-5.10.0/lib/Test.old/Harness/t/point-parse.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/point-parse.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,106 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 52;
-
-BEGIN {
- use_ok( 'Test::Harness::Point' );
- use_ok( 'Test::Harness::Straps' );
-}
-
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
-
-
-my $testlines = {
- 'not ok' => {
- ok => 0
- },
- 'not ok # TODO' => {
- ok => 0,
- reason => '',
- type => 'todo'
- },
- 'not ok 1' => {
- number => 1,
- ok => 0
- },
- 'not ok 11 - this is \\# all the name # skip this is not' => {
- description => 'this is \\# all the name',
- number => 11,
- ok => 0,
- reason => 'this is not',
- type => 'skip'
- },
- 'not ok 23 # TODO world peace' => {
- number => 23,
- ok => 0,
- reason => 'world peace',
- type => 'todo'
- },
- 'not ok 42 - universal constant' => {
- description => 'universal constant',
- number => 42,
- ok => 0
- },
- ok => {
- ok => 1
- },
- 'ok # skip' => {
- ok => 1,
- type => 'skip'
- },
- 'ok 1' => {
- number => 1,
- ok => 1
- },
- 'ok 1066 - and all that' => {
- description => 'and all that',
- number => 1066,
- ok => 1
- },
- 'ok 11 - have life # TODO get a life' => {
- description => 'have life',
- number => 11,
- ok => 1,
- reason => 'get a life',
- type => 'todo'
- },
- 'ok 2938' => {
- number => 2938,
- ok => 1
- },
- 'ok 42 - _is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because' => {
- description => '_is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because',
- number => 42,
- ok => 1
- }
-};
-my @untests = (
- ' ok',
- 'not',
- 'okay 23',
- );
-
-for my $line ( sort keys %$testlines ) {
- my $point = Test::Harness::Point->from_test_line( $line );
- isa_ok( $point, 'Test::Harness::Point' );
-
- my $fields = $testlines->{$line};
- for my $property ( sort keys %$fields ) {
- my $value = $fields->{$property};
- is( eval "\$point->$property", $value, "$property on $line" );
- # Perls pre-5.6 can't handle $point->$property, and must be eval()d
- }
-}
diff -urN Test.old/Harness/t/point.t Test/Harness/t/point.t
--- perl-5.10.0/lib/Test.old/Harness/t/point.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/point.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,58 +0,0 @@
-#!perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 11;
-
-BEGIN {
- use_ok( 'Test::Harness::Point' );
-}
-
-my $point = Test::Harness::Point->new;
-isa_ok( $point, 'Test::Harness::Point' );
-ok( !$point->ok, "Should start out not OK" );
-
-$point->set_ok( 1 );
-ok( $point->ok, "should have turned to true" );
-
-$point->set_ok( 0 );
-ok( !$point->ok, "should have turned false" );
-
-$point->set_number( 2112 );
-is( $point->number, 2112, "Number is set" );
-
-$point->set_description( "Blah blah" );
-is( $point->description, "Blah blah", "Description set" );
-
-$point->set_directive( "Go now" );
-is( $point->directive, "Go now", "Directive set" );
-
-$point->add_diagnostic( "# Line 1" );
-$point->add_diagnostic( "# Line two" );
-$point->add_diagnostic( "# Third line" );
-my @diags = $point->diagnostics;
-is( @diags, 3, "Three lines" );
-is_deeply(
- \@diags,
- [ "# Line 1", "# Line two", "# Third line" ],
- "Diagnostics in list context"
-);
-
-my $diagstr = <<EOF;
-# Line 1
-# Line two
-# Third line
-EOF
-
-chomp $diagstr;
-my $string_diagnostics = $point->diagnostics;
-is( $string_diagnostics, $diagstr, "Diagnostics in scalar context" );
diff -urN Test.old/Harness/t/prove-globbing.t Test/Harness/t/prove-globbing.t
--- perl-5.10.0/lib/Test.old/Harness/t/prove-globbing.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/prove-globbing.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,32 +0,0 @@
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-use Test::More;
-plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
-plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-
-plan tests => 1;
-
-my $tests = File::Spec->catfile( 't', 'prove*.t' );
-my $prove = File::Spec->catfile( File::Spec->curdir, "blib", "script", "prove" );
-$prove = "$^X $prove";
-
-GLOBBAGE: {
- my @actual = sort qx/$prove --dry $tests/;
- chomp @actual;
-
- my @expected = (
- File::Spec->catfile( "t", "prove-globbing.t" ),
- File::Spec->catfile( "t", "prove-switches.t" ),
- );
- is_deeply( \@actual, \@expected, "Expands the wildcards" );
-}
diff -urN Test.old/Harness/t/prove-switches.t Test/Harness/t/prove-switches.t
--- perl-5.10.0/lib/Test.old/Harness/t/prove-switches.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/prove-switches.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,71 +0,0 @@
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-use Test::More;
-plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
-plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-
-plan tests => 8;
-
-my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
-my $blib_lib = File::Spec->catfile( $blib, "lib" );
-my $blib_arch = File::Spec->catfile( $blib, "arch" );
-my $prove = File::Spec->catfile( $blib, "script", "prove" );
-$prove = "$^X $prove";
-
-CAPITAL_TAINT: {
- local $ENV{PROVE_SWITCHES};
-
- my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/;
- my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
- is_deeply( \@actual, \@expected, "Capital taint flags OK" );
-}
-
-LOWERCASE_TAINT: {
- local $ENV{PROVE_SWITCHES};
-
- my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/;
- my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
- is_deeply( \@actual, \@expected, "Lowercase taint OK" );
-}
-
-PROVE_SWITCHES: {
- local $ENV{PROVE_SWITCHES} = "-dvb -I fark";
-
- my @actual = qx/$prove -Ibork -Dd/;
- my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_SWITCHES_L: {
- my @actual = qx/$prove -l -Ibongo -Dd/;
- my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_SWITCHES_LB: {
- my @actual = qx/$prove -lb -Dd/;
- my @expected = ( "# \$Test::Harness::Switches: -Ilib -I$blib_arch -I$blib_lib\n" );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_VERSION: {
- # This also checks that the prove $VERSION is in sync with Test::Harness's $VERSION
- local $/ = undef;
-
- use_ok( 'Test::Harness' );
-
- my $thv = $Test::Harness::VERSION;
- my @actual = qx/$prove --version/;
- is( scalar @actual, 1, 'Only 1 line returned' );
- like( $actual[0], qq{/^\Qprove v$thv, using Test::Harness v$thv and Perl v5\E/} );
-}
diff -urN Test.old/Harness/t/strap-analyze.t Test/Harness/t/strap-analyze.t
--- perl-5.10.0/lib/Test.old/Harness/t/strap-analyze.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/strap-analyze.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,599 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 247;
-use File::Spec;
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-
-my $IsMacPerl = $^O eq 'MacOS';
-my $IsVMS = $^O eq 'VMS';
-
-# VMS uses native, not POSIX, exit codes.
-my $die_exit = $IsVMS ? 44 : 1;
-
-# We can only predict that the wait status should be zero or not.
-my $wait_non_zero = 1;
-
-my %samples = (
- bignum => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 2,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- combined => {
- bonus => 1,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- name => "basset hounds got long ears",
- ok => 1
- },
- {
- actual_ok => 0,
- name => "all hell broke lose",
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1,
- reason => "contract negociations",
- type => "skip"
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 0,
- ok => 1,
- type => "todo"
- }
- ],
- 'exit' => 0,
- max => 10,
- ok => 8,
- passing => 0,
- seen => 10,
- skip => 1,
- todo => 2,
- 'wait' => 0
- },
- descriptive => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- name => "Interlock activated",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Megathrusters are go",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Head formed",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Blazing sword formed",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Robeast destroyed",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- 'die' => {
- bonus => 0,
- details => [],
- 'exit' => $die_exit,
- max => 0,
- ok => 0,
- passing => 0,
- seen => 0,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- die_head_end => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 4,
- ],
- 'exit' => $die_exit,
- max => 0,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- die_last_minute => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 4,
- ],
- 'exit' => $die_exit,
- max => 4,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- duplicates => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 10,
- ],
- 'exit' => 0,
- max => 10,
- ok => 11,
- passing => 0,
- seen => 11,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- head_end => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 3,
- {
- actual_ok => 1,
- diagnostics => "comment\nmore ignored stuff\nand yet more\n",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 4,
- ok => 4,
- passing => 1,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- head_fail => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- diagnostics => "comment\nmore ignored stuff\nand yet more\n",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 4,
- ok => 3,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- lone_not_bug => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 4,
- ],
- 'exit' => 0,
- max => 4,
- ok => 4,
- passing => 1,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- no_output => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 0,
- seen => 0,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- shbang_misparse => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 2,
- ],
- 'exit' => 0,
- max => 2,
- ok => 2,
- passing => 1,
- seen => 2,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- simple => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 5,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- simple_fail => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 3,
- passing => 0,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- skip => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1,
- reason => "rain delay",
- type => "skip"
- },
- ({
- actual_ok => 1,
- ok => 1
- }) x 3,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 1,
- todo => 0,
- 'wait' => 0
- },
- skip_nomsg => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1,
- reason => "",
- type => "skip"
- }
- ],
- 'exit' => 0,
- max => 1,
- ok => 1,
- passing => 1,
- seen => 1,
- skip => 1,
- todo => 0,
- 'wait' => 0
- },
- skipall => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 1,
- seen => 0,
- skip => 0,
- skip_all => "rope",
- todo => 0,
- 'wait' => 0
- },
- skipall_nomsg => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 1,
- seen => 0,
- skip => 0,
- skip_all => "",
- todo => 0,
- 'wait' => 0
- },
- taint => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- name => "-T honored",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 1,
- ok => 1,
- passing => 1,
- seen => 1,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- todo => {
- bonus => 1,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 0,
- ok => 1,
- type => "todo"
- },
- ({
- actual_ok => 1,
- ok => 1
- }) x 2,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 2,
- 'wait' => 0
- },
- vms_nit => {
- bonus => 0,
- details => [
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 2,
- ok => 1,
- passing => 0,
- seen => 2,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- with_comments => {
- bonus => 2,
- details => [
- {
- actual_ok => 0,
- diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n",
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 1,
- ok => 1,
- reason => "at line 10 TODO?!)",
- type => "todo"
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n",
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 1,
- diagnostics => "woo\n",
- ok => 1,
- reason => "at line 13 TODO?!)",
- type => "todo"
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 4,
- 'wait' => 0
- },
-);
-
-use Test::Harness::Straps;
-my @_INC = map { qq{"-I$_"} } @INC;
-$Test::Harness::Switches = "@_INC -Mstrict";
-
-$SIG{__WARN__} = sub {
- warn @_ unless $_[0] =~ /^Enormous test number/ ||
- $_[0] =~ /^Can't detailize/
-};
-
-for my $test ( sort keys %samples ) {
- print "# Working on $test\n";
- my $expect = $samples{$test};
-
- for my $n ( 0..$#{$expect->{details}} ) {
- for my $field ( qw( type name reason ) ) {
- $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field};
- }
- }
-
- my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
- my $results = $strap->analyze_file($test_path);
-
- is_deeply($results->details, $expect->{details}, qq{details of "$test"} );
-
- delete $expect->{details};
-
- SKIP: {
- skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
-
- # We can only check if it's zero or non-zero.
- is( !$results->wait, !$expect->{'wait'}, 'wait status' );
- delete $expect->{'wait'};
-
- # Have to check the exit status seperately so we can skip it
- # in MacPerl.
- is( $results->exit, $expect->{'exit'}, 'exit matches' );
- delete $expect->{'exit'};
- }
-
- for my $field ( sort keys %$expect ) {
- is( $results->$field(), $expect->{$field}, "Field $field" );
- }
-} # for %samples
-
-NON_EXISTENT_FILE: {
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
- ok( !$strap->analyze_file('I_dont_exist'), "Can't analyze a non-existant file" );
- is( $strap->{error}, "I_dont_exist does not exist", "And there should be one error" );
-}
diff -urN Test.old/Harness/t/strap.t Test/Harness/t/strap.t
--- perl-5.10.0/lib/Test.old/Harness/t/strap.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/strap.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,158 +0,0 @@
-#!/usr/bin/perl -Tw
-
-use strict;
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More tests => 89;
-
-BEGIN { use_ok('Test::Harness::Straps'); }
-
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
-
-### Testing _is_diagnostic()
-
-my $comment;
-ok( !$strap->_is_diagnostic("foo", \$comment), '_is_diagnostic(), not a comment' );
-ok( !defined $comment, ' no comment set' );
-
-ok( !$strap->_is_diagnostic("f # oo", \$comment), ' not a comment with #' );
-ok( !defined $comment, ' no comment set' );
-
-my %comments = (
- "# stuff and things # and stuff" =>
- ' stuff and things # and stuff',
- " # more things " => ' more things ',
- "#" => '',
- );
-
-for my $line ( sort keys %comments ) {
- my $line_comment = $comments{$line};
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- my $name = substr($line, 0, 20);
- ok( $strap->_is_diagnostic($line, \$comment), " comment '$name'" );
- is( $comment, $line_comment, ' right comment set' );
-}
-
-
-
-### Testing _is_header()
-
-my @not_headers = (' 1..2',
- '1..M',
- '1..-1',
- '2..2',
- '1..a',
- '',
- );
-
-foreach my $unheader (@not_headers) {
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- ok( !$strap->_is_header($unheader),
- "_is_header(), not a header '$unheader'" );
-
- ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
- " max, todo and skip_all are not set" );
-}
-
-
-my @attribs = qw(max skip_all todo);
-my %headers = (
- '1..2' => { max => 2 },
- '1..1' => { max => 1 },
- '1..0' => { max => 0,
- skip_all => '',
- },
- '1..0 # Skipped: no leverage found' => { max => 0,
- skip_all => 'no leverage found',
- },
- '1..4 # Skipped: no leverage found' => { max => 4,
- skip_all => 'no leverage found',
- },
- '1..0 # skip skip skip because' => { max => 0,
- skip_all => 'skip skip because',
- },
- '1..10 todo 2 4 10' => { max => 10,
- 'todo' => { 2 => 1,
- 4 => 1,
- 10 => 1,
- },
- },
- '1..10 todo' => { max => 10 },
- '1..192 todo 4 2 13 192 # Skip skip skip because' =>
- { max => 192,
- 'todo' => { 4 => 1,
- 2 => 1,
- 13 => 1,
- 192 => 1,
- },
- skip_all => 'skip skip because'
- }
-);
-
-for my $header ( sort keys %headers ) {
- my $expect = $headers{$header};
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
-
- is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
- if defined $expect->{skip_all};
-
- ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs],
- [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
- ' the right attributes are there' );
-}
-
-
-
-### Test _is_bail_out()
-
-my %bails = (
- 'Bail out!' => undef,
- 'Bail out! Wing on fire.' => 'Wing on fire.',
- 'BAIL OUT!' => undef,
- 'bail out! - Out of coffee' => '- Out of coffee',
- );
-
-for my $line ( sort keys %bails ) {
- my $expect = $bails{$line};
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- my $reason;
- ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
- is( $reason, $expect, ' with the right reason' );
-}
-
-my @unbails = (
- ' Bail out!',
- 'BAIL OUT',
- 'frobnitz',
- 'ok 23 - BAIL OUT!',
- );
-
-foreach my $line (@unbails) {
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- my $reason;
-
- ok( !$strap->_is_bail_out($line, \$reason),
- "_is_bail_out() ignores '$line'" );
- is( $reason, undef, ' and gives no reason' );
-}
diff -urN Test.old/Harness/t/test-harness.t Test/Harness/t/test-harness.t
--- perl-5.10.0/lib/Test.old/Harness/t/test-harness.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/test-harness.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,562 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-
-use Test::More;
-use Dev::Null;
-
-my $IsMacPerl = $^O eq 'MacOS';
-my $IsVMS = $^O eq 'VMS';
-
-# VMS uses native, not POSIX, exit codes.
-# MacPerl's exit codes are broken.
-my $die_estat = $IsVMS ? 44 :
- $IsMacPerl ? 0 :
- 1;
-
-my %samples = (
- simple => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- simple_fail => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2 5',
- },
- all_ok => 0,
- },
- descriptive => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- no_nums => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3',
- },
- all_ok => 0,
- },
- 'todo' => {
- total => {
- bonus => 1,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- todo_inline => {
- total => {
- bonus => 1,
- max => 3,
- 'ok' => 3,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- 'skip' => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- 'skip_nomsg' => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- bailout => 0,
- combined => {
- total => {
- bonus => 1,
- max => 10,
- 'ok' => 8,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 2,
- skipped => 0
- },
- failed => {
- canon => '3 9',
- },
- all_ok => 0,
- },
- duplicates => {
- total => {
- bonus => 0,
- max => 10,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- head_end => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- head_fail => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2',
- },
- all_ok => 0,
- },
- no_output => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- },
- all_ok => 0,
- },
- skipall => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => { },
- all_ok => 1,
- },
- skipall_nomsg => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => { },
- all_ok => 1,
- },
- with_comments => {
- total => {
- bonus => 2,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 4,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- taint => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
-
- taint_warn => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
-
- 'die' => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => '??',
- failed => '??',
- canon => '??',
- },
- all_ok => 0,
- },
-
- die_head_end => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => '??',
- failed => '??',
- canon => '??',
- },
- all_ok => 0,
- },
-
- die_last_minute => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => 4,
- failed => 0,
- canon => '??',
- },
- all_ok => 0,
- },
- bignum => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- bignum_many => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3-100000',
- },
- all_ok => 0,
- },
- 'shbang_misparse' => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 2,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- too_many => {
- total => {
- bonus => 0,
- max => 3,
- 'ok' => 7,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '4-7',
- },
- all_ok => 0,
- },
- switches => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- );
-
-my $tests_per_loop = 8;
-plan tests => (keys(%samples) * $tests_per_loop);
-
-use Test::Harness;
-my @_INC = map { qq{"-I$_"} } @INC;
-$Test::Harness::Switches = "@_INC -Mstrict";
-
-tie *NULL, 'Dev::Null' or die $!;
-
-for my $test ( sort keys %samples ) {
-SKIP: {
- skip "-t introduced in 5.8.0", $tests_per_loop
- if ($test eq 'taint_warn') && ($] < 5.008);
-
- my $expect = $samples{$test};
-
- # execute_tests() runs the tests but skips the formatting.
- my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
-
- print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
- my $totals;
- my $failed;
- my $warning = '';
- eval {
- local $SIG{__WARN__} = sub { $warning .= join '', @_; };
- ($totals, $failed) = Test::Harness::execute_tests(tests => [$test_path], out => \*NULL);
- };
-
- # $? is unreliable in MacPerl, so we'll just fudge it.
- $failed->{estat} = $die_estat if $IsMacPerl and $failed;
-
- SKIP: {
- skip "special tests for bailout", 1 unless $test eq 'bailout';
- like( $@, '/Further testing stopped: GERONI/i' );
- }
-
- SKIP: {
- skip "don't apply to a bailout", 6 if $test eq 'bailout';
- is( $@, '', '$@ is empty' );
- is( Test::Harness::_all_ok($totals), $expect->{all_ok},
- "$test - all ok" );
- ok( defined $expect->{total}, "$test - has total" );
- is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}},
- $expect->{total},
- "$test - totals" );
- is_deeply( {map { $_=>$failed->{$test_path}{$_} }
- keys %{$expect->{failed}}},
- $expect->{failed},
- "$test - failed" );
-
- skip "No tests were run", 1 unless $totals->{max};
-
- my $output = Test::Harness::get_results($totals, $failed);
- like( $output, '/All tests successful|List of Failed/', 'Got what looks like a valid summary' );
- }
-
- my $expected_warnings = "";
- if ( $test eq "bignum" ) {
- $expected_warnings = <<WARN;
-Enormous test number seen [test 136211425]
-Can't detailize, too big.
-WARN
- }
- elsif ( $test eq 'bignum_many' ) {
- $expected_warnings = <<WARN;
-Enormous test number seen [test 100001]
-Can't detailize, too big.
-WARN
- }
- my $desc = $expected_warnings ? 'Got proper warnings' : 'No warnings';
- is( $warning, $expected_warnings, "$test - $desc" );
-} # taint SKIP block
-} # for tests
diff -urN Test.old/Harness/t/version.t Test/Harness/t/version.t
--- perl-5.10.0/lib/Test.old/Harness/t/version.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/t/version.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,23 +0,0 @@
-#!/usr/bin/perl -Tw
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 3;
-
-BEGIN {
- use_ok('Test::Harness');
-}
-
-my $ver = $ENV{HARNESS_VERSION} or die "HARNESS_VERSION not set";
-ok( $ver =~ /^2.\d\d(_\d\d)?$/, "Version is proper format" );
-is( $ver, $Test::Harness::VERSION );
diff -urN Test.old/Harness/TAP.pod Test/Harness/TAP.pod
--- perl-5.10.0/lib/Test.old/Harness/TAP.pod 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/TAP.pod 1970-01-01 01:00:00.000000000 +0100
@@ -1,492 +0,0 @@
-=head1 NAME
-
-Test::Harness::TAP - Documentation for the TAP format
-
-=head1 SYNOPSIS
-
-TAP, the Test Anything Protocol, is Perl's simple text-based interface
-between testing modules such as Test::More and the test harness
-Test::Harness.
-
-=head1 TODO
-
-Exit code of the process.
-
-=head1 THE TAP FORMAT
-
-TAP's general format is:
-
- 1..N
- ok 1 Description # Directive
- # Diagnostic
- ....
- ok 47 Description
- ok 48 Description
- more tests....
-
-For example, a test file's output might look like:
-
- 1..4
- ok 1 - Input file opened
- not ok 2 - First line of the input valid
- ok 3 - Read the rest of the file
- not ok 4 - Summarized correctly # TODO Not written yet
-
-=head1 HARNESS BEHAVIOR
-
-In this document, the "harness" is any program analyzing TAP output.
-Typically this will be Perl's I<prove> program, or the underlying
-C<Test::Harness::runtests> subroutine.
-
-A harness must only read TAP output from standard output and not
-from standard error. Lines written to standard output matching
-C</^(not )?ok\b/> must be interpreted as test lines. All other
-lines must not be considered test output.
-
-=head1 TESTS LINES AND THE PLAN
-
-=head2 The plan
-
-The plan tells how many tests will be run, or how many tests have
-run. It's a check that the test file hasn't stopped prematurely.
-It must appear once, whether at the beginning or end of the output.
-
-The plan is usually the first line of TAP output and it specifies how
-many test points are to follow. For example,
-
- 1..10
-
-means you plan on running 10 tests. This is a safeguard in case your test
-file dies silently in the middle of its run. The plan is optional but if
-there is a plan before the test points it must be the first non-diagnostic
-line output by the test file.
-
-In certain instances a test file may not know how many test points
-it will ultimately be running. In this case the plan can be the last
-non-diagnostic line in the output.
-
-The plan cannot appear in the middle of the output, nor can it appear more
-than once.
-
-=head2 The test line
-
-The core of TAP is the test line. A test file prints one test line test
-point executed. There must be at least one test line in TAP output. Each
-test line comprises the following elements:
-
-=over 4
-
-=item * C<ok> or C<not ok>
-
-This tells whether the test point passed or failed. It must be
-at the beginning of the line. C</^not ok/> indicates a failed test
-point. C</^ok/> is a successful test point. This is the only mandatory
-part of the line.
-
-Note that unlike the Directives below, C<ok> and C<not ok> are
-case-sensitive.
-
-=item * Test number
-
-TAP expects the C<ok> or C<not ok> to be followed by a test point
-number. If there is no number the harness must maintain
-its own counter until the script supplies test numbers again. So
-the following test output
-
- 1..6
- not ok
- ok
- not ok
- ok
- ok
-
-has five tests. The sixth is missing. Test::Harness will generate
-
- FAILED tests 1, 3, 6
- Failed 3/6 tests, 50.00% okay
-
-=item * Description
-
-Any text after the test number but before a C<#> is the description of
-the test point.
-
- ok 42 this is the description of the test
-
-Descriptions should not begin with a digit so that they are not confused
-with the test point number.
-
-The harness may do whatever it wants with the description.
-
-=item * Directive
-
-The test point may include a directive, following a hash on the
-test line. There are currently two directives allowed: C<TODO> and
-C<SKIP>. These are discussed below.
-
-=back
-
-To summarize:
-
-=over 4
-
-=item * ok/not ok (required)
-
-=item * Test number (recommended)
-
-=item * Description (recommended)
-
-=item * Directive (only when necessary)
-
-=back
-
-=head1 DIRECTIVES
-
-Directives are special notes that follow a C<#> on the test line.
-Only two are currently defined: C<TODO> and C<SKIP>. Note that
-these two keywords are not case-sensitive.
-
-=head2 TODO tests
-
-If the directive starts with C<# TODO>, the test is counted as a
-todo test, and the text after C<TODO> is the explanation.
-
- not ok 13 # TODO bend space and time
-
-Note that if the TODO has an explanation it must be separated from
-C<TODO> by a space.
-
-These tests represent a feature to be implemented or a bug to be fixed
-and act as something of an executable "things to do" list. They are
-B<not> expected to succeed. Should a todo test point begin succeeding,
-the harness should 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 point.
-
-=head2 Skipping tests
-
-If the directive starts with C<# SKIP>, the test is counted as having
-been skipped. If the whole test file succeeds, the count of skipped
-tests is included in the generated output. The harness should report
-the text after C< # SKIP\S*\s+> as a reason for skipping.
-
- ok 23 # skip Insufficient flogiston pressure.
-
-Similarly, one can include an explanation in a plan line,
-emitted if the test file is skipped completely:
-
- 1..0 # Skipped: WWW::Mechanize not installed
-
-=head1 OTHER LINES
-
-=head2 Bail out!
-
-As an emergency measure a test script can decide that further tests
-are useless (e.g. missing dependencies) and testing should stop
-immediately. In that case the test script prints the magic words
-
- Bail out!
-
-to standard output. Any message after these words must be displayed
-by the interpreter as the reason why testing must be stopped, as
-in
-
- Bail out! MySQL is not running.
-
-=head2 Diagnostics
-
-Additional information may be put into the testing output on separate
-lines. Diagnostic lines should begin with a C<#>, which the harness must
-ignore, at least as far as analyzing the test results. The harness is
-free, however, to display the diagnostics. Typically diagnostics are
-used to provide information about the environment in which test file is
-running, or to delineate a group of tests.
-
- ...
- ok 18 - Closed database connection
- # End of database section.
- # This starts the network part of the test.
- # Daemon started on port 2112
- ok 19 - Opened socket
- ...
- ok 47 - Closed socket
- # End of network tests
-
-=head2 Anything else
-
-Any output line that is not a plan, a test line or a diagnostic is
-incorrect. How a harness handles the incorrect line is undefined.
-Test::Harness silently ignores incorrect lines, but will become more
-stringent in the future.
-
-=head1 EXAMPLES
-
-All names, places, and events depicted in any example are wholly
-fictitious and bear no resemblance to, connection with, or relation to any
-real entity. Any such similarity is purely coincidental, unintentional,
-and unintended.
-
-=head2 Common with explanation
-
-The following TAP listing declares that six tests follow as well as
-provides handy feedback as to what the test is about to do. All six
-tests pass.
-
- 1..6
- #
- # Create a new Board and Tile, then place
- # the Tile onto the board.
- #
- ok 1 - The object isa Board
- ok 2 - Board size is zero
- ok 3 - The object isa Tile
- ok 4 - Get possible places to put the Tile
- ok 5 - Placing the tile produces no error
- ok 6 - Board size is 1
-
-=head2 Unknown amount and failures
-
-This hypothetical test program ensures that a handful of servers are
-online and network-accessible. Because it retrieves the hypothetical
-servers from a database, it doesn't know exactly how many servers it
-will need to ping. Thus, the test count is declared at the bottom after
-all the test points have run. Also, two of the tests fail.
-
- ok 1 - retrieving servers from the database
- # need to ping 6 servers
- ok 2 - pinged diamond
- ok 3 - pinged ruby
- not ok 4 - pinged saphire
- ok 5 - pinged onyx
- not ok 6 - pinged quartz
- ok 7 - pinged gold
- 1..7
-
-=head2 Giving up
-
-This listing reports that a pile of tests are going to be run. However,
-the first test fails, reportedly because a connection to the database
-could not be established. The program decided that continuing was
-pointless and exited.
-
- 1..573
- not ok 1 - database handle
- Bail out! Couldn't connect to database.
-
-=head2 Skipping a few
-
-The following listing plans on running 5 tests. However, our program
-decided to not run tests 2 thru 5 at all. To properly report this,
-the tests are marked as being skipped.
-
- 1..5
- ok 1 - approved operating system
- # $^0 is solaris
- ok 2 - # SKIP no /sys directory
- ok 3 - # SKIP no /sys directory
- ok 4 - # SKIP no /sys directory
- ok 5 - # SKIP no /sys directory
-
-=head2 Skipping everything
-
-This listing shows that the entire listing is a skip. No tests were run.
-
- 1..0 # skip because English-to-French translator isn't installed
-
-=head2 Got spare tuits?
-
-The following example reports that four tests are run and the last two
-tests failed. However, because the failing tests are marked as things
-to do later, they are considered successes. Thus, a harness should report
-this entire listing as a success.
-
- 1..4
- ok 1 - Creating test program
- ok 2 - Test program runs, no error
- not ok 3 - infinite loop # TODO halting problem unsolved
- not ok 4 - infinite loop 2 # TODO halting problem unsolved
-
-=head2 Creative liberties
-
-This listing shows an alternate output where the test numbers aren't
-provided. The test also reports the state of a ficticious board game in
-diagnostic form. Finally, the test count is reported at the end.
-
- ok - created Board
- ok
- ok
- ok
- ok
- ok
- ok
- ok
- # +------+------+------+------+
- # | |16G | |05C |
- # | |G N C | |C C G |
- # | | G | | C +|
- # +------+------+------+------+
- # |10C |01G | |03C |
- # |R N G |G A G | |C C C |
- # | R | G | | C +|
- # +------+------+------+------+
- # | |01G |17C |00C |
- # | |G A G |G N R |R N R |
- # | | G | R | G |
- # +------+------+------+------+
- ok - board has 7 tiles + starter tile
- 1..9
-
-=head1 Non-Perl TAP
-
-In Perl, we use Test::Simple and Test::More to generate TAP output.
-Other languages have solutions that generate TAP, so that they can take
-advantage of Test::Harness.
-
-The following sections are provided by their maintainers, and may not
-be up-to-date.
-
-=head2 C/C++
-
-libtap makes it easy to write test programs in C that produce
-TAP-compatible output. Modeled on the Test::More API, libtap contains
-all the functions you need to:
-
-=over 4
-
-=item * Specify a test plan
-
-=item * Run tests
-
-=item * Skip tests in certain situations
-
-=item * Have TODO tests
-
-=item * Produce TAP compatible diagnostics
-
-=back
-
-More information about libtap, including download links, checksums,
-anonymous access to the Subersion repository, and a bug tracking
-system, can be found at:
-
- http://jc.ngo.org.uk/trac-bin/trac.cgi/wiki/LibTap
-
-(Nik Clayton, April 17, 2006)
-
-=head2 Python
-
-PyTap will, when it's done, provide a simple, assertive (Test::More-like)
-interface for writing tests in Python. It will output TAP and will
-include the functionality found in Test::Builder and Test::More. It will
-try to make it easy to add more test code (so you can write your own
-C<TAP.StringDiff>, for example.
-
-Right now, it's got a fair bit of the basics needed to emulate Test::More,
-and I think it's easy to add more stuff -- just like Test::Builder,
-there's a singleton that you can get at easily.
-
-I need to better identify and finish implementing the most basic tests.
-I am not a Python guru, I just use it from time to time, so my aim may
-not be true. I need to write tests for it, which means either relying
-on Perl for the tester tester, or writing one in Python.
-
-Here's a sample test, as found in my Subversion:
-
- from TAP.Simple import *
-
- plan(15)
-
- ok(1)
- ok(1, "everything is OK!")
- ok(0, "always fails")
-
- is_ok(10, 10, "is ten ten?")
- is_ok(ok, ok, "even ok is ok!")
- ok(id(ok), "ok is not the null pointer")
- ok(True, "the Truth will set you ok")
- ok(not False, "and nothing but the truth")
- ok(False, "and we'll know if you lie to us")
-
- isa_ok(10, int, "10")
- isa_ok('ok', str, "some string")
-
- ok(0, "zero is true", todo="be more like Ruby!")
- ok(None, "none is true", skip="not possible in this universe")
-
- eq_ok("not", "equal", "two strings are not equal");
-
-(Ricardo Signes, April 17, 2006)
-
-=head2 JavaScript
-
-Test.Simple looks and acts just like TAP, although in reality it's
-tracking test results in an object rather than scraping them from a
-print buffer.
-
- http://openjsan.org/doc/t/th/theory/Test/Simple/
-
-(David Wheeler, April 17, 2006)
-
-=head2 PHP
-
-All the big PHP players now produce TAP
-
-=over
-
-=item * phpt
-
-Outputs TAP by default as of the yet-to-be-released PEAR 1.5.0
-
- http://pear.php.net/PEAR
-
-=item * PHPUnit
-
-Has a TAP logger (since 2.3.4)
-
- http://www.phpunit.de/wiki/Main_Page
-
-=item * SimpleTest
-
-There's a third-party TAP reporting extension for SimpleTest
-
- http://www.digitalsandwich.com/archives/51-Updated-Simpletest+Apache-Test.html
-
-=item * Apache-Test
-
-Apache-Test's PHP writes TAP by default and includes the standalone
-test-more.php
-
- http://search.cpan.org/dist/Apache-Test/
-
-=back
-
-(Geoffrey Young, April 17, 2006)
-
-=head1 AUTHORS
-
-Andy Lester, based on the original Test::Harness documentation by Michael Schwern.
-
-=head1 ACKNOWLEDGEMENTS
-
-Thanks to
-Pete Krawczyk,
-Paul Johnson,
-Ian Langworth
-and Nik Clayton
-for help and contributions on this document.
-
-The basis for the TAP format was created by Larry Wall in the
-original test script for Perl 1. Tim Bunce and Andreas Koenig
-developed it further with their modifications to Test::Harness.
-
-=head1 COPYRIGHT
-
-Copyright 2003-2005 by
-Michael G Schwern C<< <schwern@pobox.com> >>,
-Andy Lester C<< <andy@petdance.com> >>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>.
-
-=cut
diff -urN Test.old/Harness/Util.pm Test/Harness/Util.pm
--- perl-5.10.0/lib/Test.old/Harness/Util.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness/Util.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,133 +0,0 @@
-package Test::Harness::Util;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = '0.01';
-
-use File::Spec;
-use Exporter;
-use vars qw( @ISA @EXPORT @EXPORT_OK );
-
-@ISA = qw( Exporter );
-@EXPORT = ();
-@EXPORT_OK = qw( all_in shuffle blibdirs );
-
-=head1 NAME
-
-Test::Harness::Util - Utility functions for Test::Harness::*
-
-=head1 SYNOPSIS
-
-Utility functions for Test::Harness::*
-
-=head1 PUBLIC FUNCTIONS
-
-The following are all available to be imported to your module. No symbols
-are exported by default.
-
-=head2 all_in( {parm => value, parm => value} )
-
-Finds all the F<*.t> in a directory. Knows to skip F<.svn> and F<CVS>
-directories.
-
-Valid parms are:
-
-=over
-
-=item start
-
-Starting point for the search. Defaults to ".".
-
-=item recurse
-
-Flag to say whether it should recurse. Default to true.
-
-=back
-
-=cut
-
-sub all_in {
- my $parms = shift;
- my %parms = (
- start => ".",
- recurse => 1,
- %$parms,
- );
-
- my @hits = ();
- my $start = $parms{start};
-
- local *DH;
- if ( opendir( DH, $start ) ) {
- my @files = sort readdir DH;
- closedir DH;
- for my $file ( @files ) {
- next if $file eq File::Spec->updir || $file eq File::Spec->curdir;
- next if $file eq ".svn";
- next if $file eq "CVS";
-
- my $currfile = File::Spec->catfile( $start, $file );
- if ( -d $currfile ) {
- push( @hits, all_in( { %parms, start => $currfile } ) ) if $parms{recurse};
- }
- else {
- push( @hits, $currfile ) if $currfile =~ /\.t$/;
- }
- }
- }
- else {
- warn "$start: $!\n";
- }
-
- return @hits;
-}
-
-=head1 shuffle( @list )
-
-Returns a shuffled copy of I<@list>.
-
-=cut
-
-sub shuffle {
- # Fisher-Yates shuffle
- my $i = @_;
- while ($i) {
- my $j = rand $i--;
- @_[$i, $j] = @_[$j, $i];
- }
-}
-
-
-=head2 blibdir()
-
-Finds all the blib directories. Stolen directly from blib.pm
-
-=cut
-
-sub blibdirs {
- my $dir = File::Spec->curdir;
- if ($^O eq 'VMS') {
- ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--;
- }
- my $archdir = "arch";
- if ( $^O eq "MacOS" ) {
- # Double up the MP::A so that it's not used only once.
- $archdir = $MacPerl::Architecture = $MacPerl::Architecture;
- }
-
- my $i = 5;
- while ($i--) {
- my $blib = File::Spec->catdir( $dir, "blib" );
- my $blib_lib = File::Spec->catdir( $blib, "lib" );
- my $blib_arch = File::Spec->catdir( $blib, $archdir );
-
- if ( -d $blib && -d $blib_arch && -d $blib_lib ) {
- return ($blib_arch,$blib_lib);
- }
- $dir = File::Spec->catdir($dir, File::Spec->updir);
- }
- warn "$0: Cannot find blib\n";
- return;
-}
-
-1;
diff -urN Test.old/Harness.pm Test/Harness.pm
--- perl-5.10.0/lib/Test.old/Harness.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Harness.pm 1970-01-01 01:00:00.000000000 +0100
@@ -1,1169 +0,0 @@
-# -*- Mode: cperl; cperl-indent-level: 4 -*-
-
-package Test::Harness;
-
-require 5.00405;
-use Test::Harness::Straps;
-use Test::Harness::Assert;
-use Exporter;
-use Benchmark;
-use Config;
-use strict;
-
-
-use vars qw(
- $VERSION
- @ISA @EXPORT @EXPORT_OK
- $Verbose $Switches $Debug
- $verbose $switches $debug
- $Columns
- $Timer
- $ML $Last_ML_Print
- $Strap
- $has_time_hires
-);
-
-BEGIN {
- eval q{use Time::HiRes 'time'};
- $has_time_hires = !$@;
-}
-
-=head1 NAME
-
-Test::Harness - Run Perl standard test scripts with statistics
-
-=head1 VERSION
-
-Version 2.64
-
-=cut
-
-$VERSION = '2.64';
-
-# Backwards compatibility for exportable variable names.
-*verbose = *Verbose;
-*switches = *Switches;
-*debug = *Debug;
-
-$ENV{HARNESS_ACTIVE} = 1;
-$ENV{HARNESS_VERSION} = $VERSION;
-
-END {
- # For VMS.
- delete $ENV{HARNESS_ACTIVE};
- delete $ENV{HARNESS_VERSION};
-}
-
-my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
-
-# Stolen from Params::Util
-sub _CLASS {
- (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s) ? $_[0] : undef;
-}
-
-# Strap Overloading
-if ( $ENV{HARNESS_STRAPS_CLASS} ) {
- die 'Set HARNESS_STRAP_CLASS, singular, not HARNESS_STRAPS_CLASS';
-}
-my $HARNESS_STRAP_CLASS = $ENV{HARNESS_STRAP_CLASS} || 'Test::Harness::Straps';
-if ( $HARNESS_STRAP_CLASS =~ /\.pm$/ ) {
- # "Class" is actually a filename, that should return the
- # class name as its true return value.
- $HARNESS_STRAP_CLASS = require $HARNESS_STRAP_CLASS;
- if ( !_CLASS($HARNESS_STRAP_CLASS) ) {
- die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name";
- }
-}
-else {
- # It is a class name within the current @INC
- if ( !_CLASS($HARNESS_STRAP_CLASS) ) {
- die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name";
- }
- eval "require $HARNESS_STRAP_CLASS";
- die $@ if $@;
-}
-if ( !$HARNESS_STRAP_CLASS->isa('Test::Harness::Straps') ) {
- die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' must be a Test::Harness::Straps subclass";
-}
-
-$Strap = $HARNESS_STRAP_CLASS->new;
-
-sub strap { return $Strap };
-
-@ISA = ('Exporter');
-@EXPORT = qw(&runtests);
-@EXPORT_OK = qw(&execute_tests $verbose $switches);
-
-$Verbose = $ENV{HARNESS_VERBOSE} || 0;
-$Debug = $ENV{HARNESS_DEBUG} || 0;
-$Switches = '-w';
-$Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
-$Columns--; # Some shells have trouble with a full line of text.
-$Timer = $ENV{HARNESS_TIMER} || 0;
-
-=head1 SYNOPSIS
-
- use Test::Harness;
-
- runtests(@test_files);
-
-=head1 DESCRIPTION
-
-B<STOP!> If all you want to do is write a test script, consider
-using Test::Simple. Test::Harness is the module that reads the
-output from Test::Simple, Test::More and other modules based on
-Test::Builder. You don't need to know about Test::Harness to use
-those modules.
-
-Test::Harness runs tests and expects output from the test in a
-certain format. That format is called TAP, the Test Anything
-Protocol. It is defined in L<Test::Harness::TAP>.
-
-C<Test::Harness::runtests(@tests)> runs all the testscripts named
-as arguments and checks standard output for the expected strings
-in TAP format.
-
-The F<prove> utility is a thin wrapper around Test::Harness.
-
-=head2 Taint mode
-
-Test::Harness will honor the C<-T> or C<-t> in the #! line on your
-test files. So if you begin a test with:
-
- #!perl -T
-
-the test will be run with taint mode on.
-
-=head2 Configuration variables.
-
-These variables can be used to configure the behavior of
-Test::Harness. They are exported on request.
-
-=over 4
-
-=item C<$Test::Harness::Verbose>
-
-The package variable C<$Test::Harness::Verbose> is exportable and can be
-used to let C<runtests()> display the standard output of the script
-without altering the behavior otherwise. The F<prove> utility's C<-v>
-flag will set this.
-
-=item C<$Test::Harness::switches>
-
-The package variable C<$Test::Harness::switches> is exportable and can be
-used to set perl command line options used for running the test
-script(s). The default value is C<-w>. It overrides C<HARNESS_PERL_SWITCHES>.
-
-=item C<$Test::Harness::Timer>
-
-If set to true, and C<Time::HiRes> is available, print elapsed seconds
-after each test file.
-
-=back
-
-
-=head2 Failure
-
-When tests fail, analyze the summary report:
-
- t/base..............ok
- t/nonumbers.........ok
- t/ok................ok
- t/test-harness......ok
- t/waterloo..........dubious
- Test returned status 3 (wstat 768, 0x300)
- DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19
- Failed 10/20 tests, 50.00% okay
- Failed Test Stat Wstat Total Fail List of Failed
- ---------------------------------------------------------------
- t/waterloo.t 3 768 20 10 1 3 5 7 9 11 13 15 17 19
- Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
-
-Everything passed but F<t/waterloo.t>. It failed 10 of 20 tests and
-exited with non-zero status indicating something dubious happened.
-
-The columns in the summary report mean:
-
-=over 4
-
-=item B<Failed Test>
-
-The test file which failed.
-
-=item B<Stat>
-
-If the test exited with non-zero, this is its exit status.
-
-=item B<Wstat>
-
-The wait status of the test.
-
-=item B<Total>
-
-Total number of tests expected to run.
-
-=item B<Fail>
-
-Number which failed, either from "not ok" or because they never ran.
-
-=item B<List of Failed>
-
-A list of the tests which failed. Successive failures may be
-abbreviated (ie. 15-20 to indicate that tests 15, 16, 17, 18, 19 and
-20 failed).
-
-=back
-
-
-=head1 FUNCTIONS
-
-The following functions are available.
-
-=head2 runtests( @test_files )
-
-This runs all the given I<@test_files> and divines whether they passed
-or failed based on their output to STDOUT (details above). It prints
-out each individual test which failed along with a summary report and
-a how long it all took.
-
-It returns true if everything was ok. Otherwise it will C<die()> with
-one of the messages in the DIAGNOSTICS section.
-
-=cut
-
-sub runtests {
- my(@tests) = @_;
-
- local ($\, $,);
-
- my ($tot, $failedtests,$todo_passed) = execute_tests(tests => \@tests);
- print get_results($tot, $failedtests,$todo_passed);
-
- my $ok = _all_ok($tot);
-
- assert(($ok xor keys %$failedtests),
- q{ok status jives with $failedtests});
-
- if (! $ok) {
- die("Failed $tot->{bad}/$tot->{tests} test programs. " .
- "@{[$tot->{max} - $tot->{ok}]}/$tot->{max} subtests failed.\n");
- }
-
- return $ok;
-}
-
-# my $ok = _all_ok(\%tot);
-# Tells you if this test run is overall successful or not.
-
-sub _all_ok {
- my($tot) = shift;
-
- return $tot->{bad} == 0 && ($tot->{max} || $tot->{skipped}) ? 1 : 0;
-}
-
-# Returns all the files in a directory. This is shorthand for backwards
-# compatibility on systems where C<glob()> doesn't work right.
-
-sub _globdir {
- local *DIRH;
-
- opendir DIRH, shift;
- my @f = readdir DIRH;
- closedir DIRH;
-
- return @f;
-}
-
-=head2 execute_tests( tests => \@test_files, out => \*FH )
-
-Runs all the given C<@test_files> (just like C<runtests()>) but
-doesn't generate the final report. During testing, progress
-information will be written to the currently selected output
-filehandle (usually C<STDOUT>), or to the filehandle given by the
-C<out> parameter. The I<out> is optional.
-
-Returns a list of two values, C<$total> and C<$failed>, describing the
-results. C<$total> is a hash ref summary of all the tests run. Its
-keys and values are this:
-
- bonus Number of individual todo tests unexpectedly passed
- max Number of individual tests ran
- ok Number of individual tests passed
- sub_skipped Number of individual tests skipped
- todo Number of individual todo tests
-
- files Number of test files ran
- good Number of test files passed
- bad Number of test files failed
- tests Number of test files originally given
- skipped Number of test files skipped
-
-If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
-got a successful test.
-
-C<$failed> is a hash ref of all the test scripts that failed. Each key
-is the name of a test script, each value is another hash representing
-how that script failed. Its keys are these:
-
- name Name of the test which failed
- estat Script's exit value
- wstat Script's wait status
- max Number of individual tests
- failed Number which failed
- canon List of tests which failed (as string).
-
-C<$failed> should be empty if everything passed.
-
-=cut
-
-sub execute_tests {
- my %args = @_;
- my @tests = @{$args{tests}};
- my $out = $args{out} || select();
-
- # We allow filehandles that are symbolic refs
- no strict 'refs';
- _autoflush($out);
- _autoflush(\*STDERR);
-
- my %failedtests;
- my %todo_passed;
-
- # Test-wide totals.
- my(%tot) = (
- bonus => 0,
- max => 0,
- ok => 0,
- files => 0,
- bad => 0,
- good => 0,
- tests => scalar @tests,
- sub_skipped => 0,
- todo => 0,
- skipped => 0,
- bench => 0,
- );
-
- my @dir_files;
- @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
- my $run_start_time = new Benchmark;
-
- my $width = _leader_width(@tests);
- foreach my $tfile (@tests) {
- $Last_ML_Print = 0; # so each test prints at least once
- my($leader, $ml) = _mk_leader($tfile, $width);
- local $ML = $ml;
-
- print $out $leader;
-
- $tot{files}++;
-
- $Strap->{_seen_header} = 0;
- if ( $Test::Harness::Debug ) {
- print $out "# Running: ", $Strap->_command_line($tfile), "\n";
- }
- my $test_start_time = $Timer ? time : 0;
- my $results = $Strap->analyze_file($tfile) or
- do { warn $Strap->{error}, "\n"; next };
- my $elapsed;
- if ( $Timer ) {
- $elapsed = time - $test_start_time;
- if ( $has_time_hires ) {
- $elapsed = sprintf( " %8d ms", $elapsed*1000 );
- }
- else {
- $elapsed = sprintf( " %8s s", $elapsed ? $elapsed : "<1" );
- }
- }
- else {
- $elapsed = "";
- }
-
- # state of the current test.
- my @failed = grep { !$results->details->[$_-1]{ok} }
- 1..@{$results->details};
- my @todo_pass = grep { $results->details->[$_-1]{actual_ok} &&
- $results->details->[$_-1]{type} eq 'todo' }
- 1..@{$results->details};
-
- my %test = (
- ok => $results->ok,
- 'next' => $Strap->{'next'},
- max => $results->max,
- failed => \@failed,
- todo_pass => \@todo_pass,
- todo => $results->todo,
- bonus => $results->bonus,
- skipped => $results->skip,
- skip_reason => $results->skip_reason,
- skip_all => $Strap->{skip_all},
- ml => $ml,
- );
-
- $tot{bonus} += $results->bonus;
- $tot{max} += $results->max;
- $tot{ok} += $results->ok;
- $tot{todo} += $results->todo;
- $tot{sub_skipped} += $results->skip;
-
- my $estatus = $results->exit;
- my $wstatus = $results->wait;
-
- if ( $results->passing ) {
- # XXX Combine these first two
- if ($test{max} and $test{skipped} + $test{bonus}) {
- my @msg;
- push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
- if $test{skipped};
- if ($test{bonus}) {
- my ($txt, $canon) = _canondetail($test{todo},0,'TODO passed',
- @{$test{todo_pass}});
- $todo_passed{$tfile} = {
- canon => $canon,
- max => $test{todo},
- failed => $test{bonus},
- name => $tfile,
- estat => '',
- wstat => '',
- };
-
- push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded\n$txt");
- }
- print $out "$test{ml}ok$elapsed\n ".join(', ', @msg)."\n";
- }
- elsif ( $test{max} ) {
- print $out "$test{ml}ok$elapsed\n";
- }
- elsif ( defined $test{skip_all} and length $test{skip_all} ) {
- print $out "skipped\n all skipped: $test{skip_all}\n";
- $tot{skipped}++;
- }
- else {
- print $out "skipped\n all skipped: no reason given\n";
- $tot{skipped}++;
- }
- $tot{good}++;
- }
- else {
- # List unrun tests as failures.
- if ($test{'next'} <= $test{max}) {
- push @{$test{failed}}, $test{'next'}..$test{max};
- }
- # List overruns as failures.
- else {
- my $details = $results->details;
- foreach my $overrun ($test{max}+1..@$details) {
- next unless ref $details->[$overrun-1];
- push @{$test{failed}}, $overrun
- }
- }
-
- if ($wstatus) {
- $failedtests{$tfile} = _dubious_return(\%test, \%tot,
- $estatus, $wstatus);
- $failedtests{$tfile}{name} = $tfile;
- }
- elsif ( $results->seen ) {
- if (@{$test{failed}} and $test{max}) {
- my ($txt, $canon) = _canondetail($test{max},$test{skipped},'Failed',
- @{$test{failed}});
- print $out "$test{ml}$txt";
- $failedtests{$tfile} = { canon => $canon,
- max => $test{max},
- failed => scalar @{$test{failed}},
- name => $tfile,
- estat => '',
- wstat => '',
- };
- }
- else {
- print $out "Don't know which tests failed: got $test{ok} ok, ".
- "expected $test{max}\n";
- $failedtests{$tfile} = { canon => '??',
- max => $test{max},
- failed => '??',
- name => $tfile,
- estat => '',
- wstat => '',
- };
- }
- $tot{bad}++;
- }
- else {
- print $out "FAILED before any test output arrived\n";
- $tot{bad}++;
- $failedtests{$tfile} = { canon => '??',
- max => '??',
- failed => '??',
- name => $tfile,
- estat => '',
- wstat => '',
- };
- }
- }
-
- if (defined $Files_In_Dir) {
- my @new_dir_files = _globdir $Files_In_Dir;
- if (@new_dir_files != @dir_files) {
- my %f;
- @f{@new_dir_files} = (1) x @new_dir_files;
- delete @f{@dir_files};
- my @f = sort keys %f;
- print $out "LEAKED FILES: @f\n";
- @dir_files = @new_dir_files;
- }
- }
- } # foreach test
- $tot{bench} = timediff(new Benchmark, $run_start_time);
-
- $Strap->_restore_PERL5LIB;
-
- return(\%tot, \%failedtests, \%todo_passed);
-}
-
-# Turns on autoflush for the handle passed
-sub _autoflush {
- my $flushy_fh = shift;
- my $old_fh = select $flushy_fh;
- $| = 1;
- select $old_fh;
-}
-
-=for private _mk_leader
-
- my($leader, $ml) = _mk_leader($test_file, $width);
-
-Generates the 't/foo........' leader for the given C<$test_file> as well
-as a similar version which will overwrite the current line (by use of
-\r and such). C<$ml> may be empty if Test::Harness doesn't think you're
-on TTY.
-
-The C<$width> is the width of the "yada/blah.." string.
-
-=cut
-
-sub _mk_leader {
- my($te, $width) = @_;
- chomp($te);
- $te =~ s/\.\w+$/./;
-
- if ($^O eq 'VMS') {
- $te =~ s/^.*\.t\./\[.t./s;
- }
- my $leader = "$te" . '.' x ($width - length($te));
- my $ml = "";
-
- if ( -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose ) {
- $ml = "\r" . (' ' x 77) . "\r$leader"
- }
-
- return($leader, $ml);
-}
-
-=for private _leader_width
-
- my($width) = _leader_width(@test_files);
-
-Calculates how wide the leader should be based on the length of the
-longest test name.
-
-=cut
-
-sub _leader_width {
- my $maxlen = 0;
- my $maxsuflen = 0;
- foreach (@_) {
- my $suf = /\.(\w+)$/ ? $1 : '';
- my $len = length;
- my $suflen = length $suf;
- $maxlen = $len if $len > $maxlen;
- $maxsuflen = $suflen if $suflen > $maxsuflen;
- }
- # + 3 : we want three dots between the test name and the "ok"
- return $maxlen + 3 - $maxsuflen;
-}
-
-sub get_results {
- my $tot = shift;
- my $failedtests = shift;
- my $todo_passed = shift;
-
- my $out = '';
-
- my $bonusmsg = _bonusmsg($tot);
-
- if (_all_ok($tot)) {
- $out .= "All tests successful$bonusmsg.\n";
- if ($tot->{bonus}) {
- my($fmt_top, $fmt) = _create_fmts("Passed TODO",$todo_passed);
- # Now write to formats
- $out .= swrite( $fmt_top );
- for my $script (sort keys %{$todo_passed||{}}) {
- my $Curtest = $todo_passed->{$script};
- $out .= swrite( $fmt, @{ $Curtest }{qw(name estat wstat max failed canon)} );
- }
- }
- }
- elsif (!$tot->{tests}){
- die "FAILED--no tests were run for some reason.\n";
- }
- elsif (!$tot->{max}) {
- my $blurb = $tot->{tests}==1 ? "script" : "scripts";
- die "FAILED--$tot->{tests} test $blurb could be run, ".
- "alas--no output ever seen\n";
- }
- else {
- my $subresults = sprintf( " %d/%d subtests failed.",
- $tot->{max} - $tot->{ok}, $tot->{max} );
-
- my($fmt_top, $fmt1, $fmt2) = _create_fmts("Failed Test",$failedtests);
-
- # Now write to formats
- $out .= swrite( $fmt_top );
- for my $script (sort keys %$failedtests) {
- my $Curtest = $failedtests->{$script};
- $out .= swrite( $fmt1, @{ $Curtest }{qw(name estat wstat max failed canon)} );
- $out .= swrite( $fmt2, $Curtest->{canon} );
- }
- if ($tot->{bad}) {
- $bonusmsg =~ s/^,\s*//;
- $out .= "$bonusmsg.\n" if $bonusmsg;
- $out .= "Failed $tot->{bad}/$tot->{tests} test scripts.$subresults\n";
- }
- }
-
- $out .= sprintf("Files=%d, Tests=%d, %s\n",
- $tot->{files}, $tot->{max}, timestr($tot->{bench}, 'nop'));
- return $out;
-}
-
-sub swrite {
- my $format = shift;
- $^A = '';
- formline($format,@_);
- my $out = $^A;
- $^A = '';
- return $out;
-}
-
-
-my %Handlers = (
- header => \&header_handler,
- test => \&test_handler,
- bailout => \&bailout_handler,
-);
-
-$Strap->set_callback(\&strap_callback);
-sub strap_callback {
- my($self, $line, $type, $totals) = @_;
- print $line if $Verbose;
-
- my $meth = $Handlers{$type};
- $meth->($self, $line, $type, $totals) if $meth;
-};
-
-
-sub header_handler {
- my($self, $line, $type, $totals) = @_;
-
- warn "Test header seen more than once!\n" if $self->{_seen_header};
-
- $self->{_seen_header}++;
-
- warn "1..M can only appear at the beginning or end of tests\n"
- if $totals->seen && ($totals->max < $totals->seen);
-};
-
-sub test_handler {
- my($self, $line, $type, $totals) = @_;
-
- my $curr = $totals->seen;
- my $next = $self->{'next'};
- my $max = $totals->max;
- my $detail = $totals->details->[-1];
-
- if( $detail->{ok} ) {
- _print_ml_less("ok $curr/$max");
-
- if( $detail->{type} eq 'skip' ) {
- $totals->set_skip_reason( $detail->{reason} )
- unless defined $totals->skip_reason;
- $totals->set_skip_reason( 'various reasons' )
- if $totals->skip_reason ne $detail->{reason};
- }
- }
- else {
- _print_ml("NOK $curr/$max");
- }
-
- if( $curr > $next ) {
- print "Test output counter mismatch [test $curr]\n";
- }
- elsif( $curr < $next ) {
- print "Confused test output: test $curr answered after ".
- "test ", $next - 1, "\n";
- }
-
-};
-
-sub bailout_handler {
- my($self, $line, $type, $totals) = @_;
-
- die "FAILED--Further testing stopped" .
- ($self->{bailout_reason} ? ": $self->{bailout_reason}\n" : ".\n");
-};
-
-
-sub _print_ml {
- print join '', $ML, @_ if $ML;
-}
-
-
-# Print updates only once per second.
-sub _print_ml_less {
- my $now = CORE::time;
- if ( $Last_ML_Print != $now ) {
- _print_ml(@_);
- $Last_ML_Print = $now;
- }
-}
-
-sub _bonusmsg {
- my($tot) = @_;
-
- my $bonusmsg = '';
- $bonusmsg = (" ($tot->{bonus} subtest".($tot->{bonus} > 1 ? 's' : '').
- " UNEXPECTEDLY SUCCEEDED)")
- if $tot->{bonus};
-
- if ($tot->{skipped}) {
- $bonusmsg .= ", $tot->{skipped} test"
- . ($tot->{skipped} != 1 ? 's' : '');
- if ($tot->{sub_skipped}) {
- $bonusmsg .= " and $tot->{sub_skipped} subtest"
- . ($tot->{sub_skipped} != 1 ? 's' : '');
- }
- $bonusmsg .= ' skipped';
- }
- elsif ($tot->{sub_skipped}) {
- $bonusmsg .= ", $tot->{sub_skipped} subtest"
- . ($tot->{sub_skipped} != 1 ? 's' : '')
- . " skipped";
- }
- return $bonusmsg;
-}
-
-# Test program go boom.
-sub _dubious_return {
- my($test, $tot, $estatus, $wstatus) = @_;
-
- my $failed = '??';
- my $canon = '??';
-
- printf "$test->{ml}dubious\n\tTest returned status $estatus ".
- "(wstat %d, 0x%x)\n",
- $wstatus,$wstatus;
- print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
-
- $tot->{bad}++;
-
- if ($test->{max}) {
- if ($test->{'next'} == $test->{max} + 1 and not @{$test->{failed}}) {
- print "\tafter all the subtests completed successfully\n";
- $failed = 0; # But we do not set $canon!
- }
- else {
- push @{$test->{failed}}, $test->{'next'}..$test->{max};
- $failed = @{$test->{failed}};
- (my $txt, $canon) = _canondetail($test->{max},$test->{skipped},'Failed',@{$test->{failed}});
- print "DIED. ",$txt;
- }
- }
-
- return { canon => $canon, max => $test->{max} || '??',
- failed => $failed,
- estat => $estatus, wstat => $wstatus,
- };
-}
-
-
-sub _create_fmts {
- my $failed_str = shift;
- my $failedtests = shift;
-
- my ($type) = split /\s/,$failed_str;
- my $short = substr($type,0,4);
- my $total = $short eq 'Pass' ? 'TODOs' : 'Total';
- my $middle_str = " Stat Wstat $total $short ";
- my $list_str = "List of $type";
-
- # Figure out our longest name string for formatting purposes.
- my $max_namelen = length($failed_str);
- foreach my $script (keys %$failedtests) {
- my $namelen = length $failedtests->{$script}->{name};
- $max_namelen = $namelen if $namelen > $max_namelen;
- }
-
- my $list_len = $Columns - length($middle_str) - $max_namelen;
- if ($list_len < length($list_str)) {
- $list_len = length($list_str);
- $max_namelen = $Columns - length($middle_str) - $list_len;
- if ($max_namelen < length($failed_str)) {
- $max_namelen = length($failed_str);
- $Columns = $max_namelen + length($middle_str) + $list_len;
- }
- }
-
- my $fmt_top = sprintf("%-${max_namelen}s", $failed_str)
- . $middle_str
- . $list_str . "\n"
- . "-" x $Columns
- . "\n";
-
- my $fmt1 = "@" . "<" x ($max_namelen - 1)
- . " @>> @>>>> @>>>> @>>> "
- . "^" . "<" x ($list_len - 1) . "\n";
- my $fmt2 = "~~" . " " x ($Columns - $list_len - 2) . "^"
- . "<" x ($list_len - 1) . "\n";
-
- return($fmt_top, $fmt1, $fmt2);
-}
-
-sub _canondetail {
- my $max = shift;
- my $skipped = shift;
- my $type = shift;
- my @detail = @_;
- my %seen;
- @detail = sort {$a <=> $b} grep !$seen{$_}++, @detail;
- my $detail = @detail;
- my @result = ();
- my @canon = ();
- my $min;
- my $last = $min = shift @detail;
- my $canon;
- my $uc_type = uc($type);
- if (@detail) {
- for (@detail, $detail[-1]) { # don't forget the last one
- if ($_ > $last+1 || $_ == $last) {
- push @canon, ($min == $last) ? $last : "$min-$last";
- $min = $_;
- }
- $last = $_;
- }
- local $" = ", ";
- push @result, "$uc_type tests @canon\n";
- $canon = join ' ', @canon;
- }
- else {
- push @result, "$uc_type test $last\n";
- $canon = $last;
- }
-
- return (join("", @result), $canon)
- if $type=~/todo/i;
- push @result, "\t$type $detail/$max tests, ";
- if ($max) {
- push @result, sprintf("%.2f",100*(1-$detail/$max)), "% okay";
- }
- else {
- push @result, "?% okay";
- }
- my $ender = 's' x ($skipped > 1);
- if ($skipped) {
- my $good = $max - $detail - $skipped;
- my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
- if ($max) {
- my $goodper = sprintf("%.2f",100*($good/$max));
- $skipmsg .= "$goodper%)";
- }
- else {
- $skipmsg .= "?%)";
- }
- push @result, $skipmsg;
- }
- push @result, "\n";
- my $txt = join "", @result;
- return ($txt, $canon);
-}
-
-1;
-__END__
-
-
-=head1 EXPORT
-
-C<&runtests> is exported by Test::Harness by default.
-
-C<&execute_tests>, C<$verbose>, C<$switches> and C<$debug> are
-exported upon request.
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item C<All tests successful.\nFiles=%d, Tests=%d, %s>
-
-If all tests are successful some statistics about the performance are
-printed.
-
-=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
-
-For any single script that has failing subtests statistics like the
-above are printed.
-
-=item C<Test returned status %d (wstat %d)>
-
-Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
-and C<$?> are printed in a message similar to the above.
-
-=item C<Failed 1 test, %.2f%% okay. %s>
-
-=item C<Failed %d/%d tests, %.2f%% okay. %s>
-
-If not all tests were successful, the script dies with one of the
-above messages.
-
-=item C<FAILED--Further testing stopped: %s>
-
-If a single subtest decides that further testing will not make sense,
-the script dies with this message.
-
-=back
-
-=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS
-
-Test::Harness sets these before executing the individual tests.
-
-=over 4
-
-=item C<HARNESS_ACTIVE>
-
-This is set to a true value. It allows the tests to determine if they
-are being executed through the harness or by any other means.
-
-=item C<HARNESS_VERSION>
-
-This is the version of Test::Harness.
-
-=back
-
-=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
-
-=over 4
-
-=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_COMPILE_TEST>
-
-When true it will make harness attempt to compile the test using
-C<perlcc> before running it.
-
-B<NOTE> This currently only works when sitting in the perl source
-directory!
-
-=item C<HARNESS_DEBUG>
-
-If true, Test::Harness will print debugging information about itself as
-it runs the tests. This is different from C<HARNESS_VERBOSE>, which prints
-the output from the test being run. Setting C<$Test::Harness::Debug> will
-override this, or you can use the C<-d> switch in the F<prove> utility.
-
-=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
-
-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 predictable results.
-
-=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_PERL>
-
-Usually your tests will be run by C<$^X>, the currently-executing Perl.
-However, you may want to have it run by a different executable, such as
-a threading perl, or a different version.
-
-If you're using the F<prove> utility, you can use the C<--perl> switch.
-
-=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 C<-W> will
-run all tests with all warnings enabled.
-
-=item C<HARNESS_TIMER>
-
-Setting this to true will make the harness display the number of
-milliseconds each test took. You can also use F<prove>'s C<--timer>
-switch.
-
-=item C<HARNESS_VERBOSE>
-
-If true, Test::Harness will output the verbose results of running
-its tests. Setting C<$Test::Harness::verbose> will override this,
-or you can use the C<-v> switch in the F<prove> utility.
-
-If true, Test::Harness will output the verbose results of running
-its tests. Setting C<$Test::Harness::verbose> will override this,
-or you can use the C<-v> switch in the F<prove> utility.
-
-=item C<HARNESS_STRAP_CLASS>
-
-Defines the Test::Harness::Straps subclass to use. The value may either
-be a filename or a class name.
-
-If HARNESS_STRAP_CLASS is a class name, the class must be in C<@INC>
-like any other class.
-
-If HARNESS_STRAP_CLASS is a filename, the .pm file must return the name
-of the class, instead of the canonical "1".
-
-=back
-
-=head1 EXAMPLE
-
-Here's how Test::Harness tests itself
-
- $ cd ~/src/devel/Test-Harness
- $ perl -Mblib -e 'use Test::Harness qw(&runtests $verbose);
- $verbose=0; runtests @ARGV;' t/*.t
- Using /home/schwern/src/devel/Test-Harness/blib
- t/base..............ok
- t/nonumbers.........ok
- t/ok................ok
- t/test-harness......ok
- All tests successful.
- Files=4, Tests=24, 2 wallclock secs ( 0.61 cusr + 0.41 csys = 1.02 CPU)
-
-=head1 SEE ALSO
-
-The included F<prove> utility for running test scripts from the command line,
-L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
-the underlying timing routines, and L<Devel::Cover> for test coverage
-analysis.
-
-=head1 TODO
-
-Provide a way of running tests quietly (ie. no printing) for automated
-validation of tests. This will probably take the form of a version
-of runtests() which rather than printing its output returns raw data
-on the state of the tests. (Partially done in Test::Harness::Straps)
-
-Document the format.
-
-Fix HARNESS_COMPILE_TEST without breaking its core usage.
-
-Figure a way to report test names in the failure summary.
-
-Rework the test summary so long test names are not truncated as badly.
-(Partially done with new skip test styles)
-
-Add option for coverage analysis.
-
-Trap STDERR.
-
-Implement Straps total_results()
-
-Remember exit code
-
-Completely redo the print summary code.
-
-Straps->analyze_file() not taint clean, don't know if it can be
-
-Fix that damned VMS nit.
-
-Add a test for verbose.
-
-Change internal list of test results to a hash.
-
-Fix stats display when there's an overrun.
-
-Fix so perls with spaces in the filename work.
-
-Keeping whittling away at _run_all_tests()
-
-Clean up how the summary is printed. Get rid of those damned formats.
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-test-harness at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the F<perldoc> command.
-
- perldoc Test::Harness
-
-You can get docs for F<prove> with
-
- prove --man
-
-You can also look for information at:
-
-=over 4
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Test-Harness>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/Test-Harness>
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Harness>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Test-Harness>
-
-=back
-
-=head1 SOURCE CODE
-
-The source code repository for Test::Harness is at
-L<http://svn.perl.org/modules/Test-Harness>.
-
-=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 F<TEST> script that came
-with perl distributions for ages. Numerous anonymous contributors
-exist. Andreas Koenig held the torch for many years, and then
-Michael G Schwern.
-
-Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
-
-=head1 COPYRIGHT
-
-Copyright 2002-2006
-by Michael G Schwern C<< <schwern at pobox.com> >>,
-Andy Lester C<< <andy at petdance.com> >>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>.
-
-=cut
Reference in New Issue View Git Blame Copy Permalink