diff --git a/Changes b/Changes new file mode 100644 index 0000000..7326e50 --- /dev/null +++ b/Changes @@ -0,0 +1,904 @@ +Revision history for Test-Harness + +3.42 19-03-2018 + - Enable rulesfile.t to run in core + +3.41 27-02-2018 + - Released 3.40_01 without code modifications + +3.40_01 23-07-2017 + - Return handle for pipes and sockets #58 (Erik Huelsmann) + - TAP v13 plan allows trailing whitespace (Steffen Schwigon) + - prove: add a --statefile= option to customize the .prove file + (Ævar Arnfjörð Bjarmason) + - Avoid non-deterministic source handling, make a SourceHandler tie an + error. (Michael Schwern, Leon Timmermans) + - Fix and simplify MSWin32 colorization (Roy Ivy III) + - Fix file source handler to accept single extensions option (Tomoki Aonuma) + - Spelling fixes (Brian Wightman) + +3.39 06-04-2017 + - Make tests pass when PERL_USE_UNSAFE_INC=0 + +3.38 13-03-2017 + - Released 3.37_01 without changes + +3.37_01 + - Set PERL_USE_UNSAFE_INC when running tests using Test::Harness (Leon Timmermans) + - Avoid loading optional modules from . in prove + +3.36 30-12-2015 + - Accept YAML with trailing whitespace in header (Maik Hentsche) + - Stop bundling Test::More for testing + +3.35 2015-01-14 + - Fix prove --version to actually print the version (Leon Timmermans, #101216) + - Add --version to usage message (Leon Timmermans, #101215) + +3.34 2014-11-02 + - Enable printing CPU times spent per test (Jarkko Hietaniemi) + +3.33 2014-08-16 + - Various documentation fixes (Leon Timmermans, Justin Cook) + +3.32 2014-06-11 + - Remove harness_class from argument hash in T::H::E (Leon Timmermans) + +3.31 2014-06-07 + - Implement external rulesfile for TAP::Harness (David Golden) + - Add harness_class argument to TAP::Harness::Env (Leon Timmermans) + - Make prove respect environmental variables #28 (Leon Timmermans) + +3.30 2013-11-12 + - Fix missing parent prereq in META.{yml,json} and NotBuild.PL + (Dagfinn Ilmari Mannsåker, #89650) + - Respect PERL5LIB in tainting source handler test (Dagfinn Ilmari Mannsåker, + Leon Timmermans) + - Use base instead of parent: + + This dist is used for testing all other modules, so it should avoid + having any non-core prerequisites. Having parent as a prereq leads to a + circular dependency of parent -> Test::More -> Test::Harness. (Graham Knop) + - Various POD fixes (Nathan Gary Glenn) + - Don't localize all of %ENV in harness.t (Craig Berry) + - Give TAP::Harness::Beyond a unique NAME (Leon Timmermans) + +3.29 2013-08-10 + - Get rid of use vars in favor of our in all modules (Leon Timmermans) + and tests (Karen Etheridge) + - Added use warnings to all modules (Leon Timmermans) and tests (Karen + Etheridge) + - Use parent instead of @ISA in all modules (Leon Timmermans) and + tests (Karen Etheridge) + - Fix failing test on VMS (Craig Berry) + - Improve error message on loading failure (Leon Timmermans, #77730) + - Use Text::ParseWords, deprecate TAP::Parser::Utils + +3.28 2013-05-02 + - Bugfix: Fix taint failures on Windows (Jan Dubois) + +3.27 2013-04-30 + - Dramatically reduce memory usage (Nick Clark, RT #84939) + - Store test_num (in Grammar.pm) as a number instead of a string. + Reduces memory usage (Nick Clark, RT #84939) + - PERL5LIB is always propogated to a test's @INC, even with taint more + (Schwern, RT #84377) + - restore "always add -w to switches" behavior + +3.26 2013-01-16 + - Renamed env.opts.t to env_opts.t (for VMS) + - Skipped some TAP::Formatter::HTML tests due to this bug: #82738 + +3.26 2012-06-05 + - Rereleased to fix CPAN permission problem. No functional change. + +3.24 2012-06-03 + - RT #74393: corrected typo in M::B integration docs. + - RT #63473: fix typo. + - RT #49732: Attempt to load File::Glob::Windows to get correct + glob semantics on Win32. + - RT #47890: Don't use Win32::GetShortPathName. + - RT #64404: Ignore textness ('-T') of script when reading shebang. + - Handle the case where we don't know the wait status of the + test more gracefully. + - Make the test summary 'ok' line overrideable so that it can be + changed to a plugin to make the output of prove idempotent. + - Stop adding '-w' to perl switches by default + - Apply upstream patch: + + http://perl5.git.perl.org/perl.git/commit \ + /6359c64336d99060952232e7e300bd3c31afead8 + + In testargs.t in Test::Harness, don't run a world-writable file. + + The test writes a file, then changes the mode, then executes it. The file needs + to be +x to be executable (on many platforms). The file will need to be +w to + be deletable on some platforms. But setting the file world writable just before + running it feels like a bad idea, given that the file's name is as predictable + as process IDs, as there's a race condition to break into the account running + perl's tests. + + +3.23 2011-02-20 + - Merge in changes from core. Thanks BinGOs. + - Made SourceHandler understand that an executable binary file + is probably an executable. + - Added workaround for Getopt::Long 2.25 handling of + multivalue options. Fixes test failure on stock perl 5.6.2. + +3.22 2010-08-14 + - Allow TAP::Parser to recognize a nested BAIL_OUT directive. + - Add brief HOWTO for creating and running pgTAP tests to + TAP::Parser::SourceHandler::pgTAP. + - Fix trailing plan + embedded YAML + TAP 13 case. Thanks to + Steffen Schwigon. #54518. + - Numerous spelling fixes. Thanks to Ville Skyttä. + - Add new option --tapversion for prove to set the default + assumed TAP version. Thanks to Steffen Schwigon. + - Fixed tests to run successfully under Devel::Cover. Thanks to + Phillipe Bruhat. + - Fixed injection of test args to work with general executables + as well as Perl scripts (#59186). + - Allow multiple --ext=.foo arguments to prove, to allow running + different types of tests in the same prove run. + - App::Prove::extension() is now App::Prove::extensions(), and + returns an arrayref of extensions, rather than a single scalar. + The same change has been made to App::Prove::State::extension(). + - Preserve old semantics for test scripts with a shebang line + by favouring Perl as the intepreter for any file with a + shebang (#59457). + - Add --trap (summary on Ctrl-C) option to prove (#59427). + - Removed TAP::Parser::SourceHandler::pgTAP. Find it in its own + distribution on CPAN. + - Source options to prove can now be specified so as to be passed to + the source as a hash reference, eg: + + prove --source XYZ --xyz-option pset=foo=bar + + Ths "pset" option will be passed as a hash reference with the key + "foo" and the value "bar". + +3.21 2010-01-30 + - Add test to ensure we're not depending on a module we no + longer ship. + - Fix up skip counts for Windows case - tests were failing + on Windows. + +3.20 2010-01-22 + - Remove references / dependency on TAP::Parser::Source::Perl + +3.19 2010-01-20 + - Avoid depending on Module::Build. The resulting circular + dependency made it impossible to install Test::Harness and/or + Module::Build in some cases. + +3.18 2010-01-19 + - Handle the case where the filename of the perl executable + contains space. Thanks to kmx. + - Various documentation fixes. + +3.17_04 2010-01-04 + - Fix failures due to unknown location of Perl in t/source_handler.t. + - Use EUMM style shebang magic to produce an executable 'psql' + for t/source_handler.t. + +3.17_03 2009-11-19 + - Fix failures due to over-strict assertions in t/source.t. + +3.17_02 2009-11-17 + - Merge in Steve's missing changes. Oops. + +3.17_01 2009-11-17 + - Re-engineered source handling API to allow users to configure how + TAP is sourced by the parser. Introduced a new 'sources' param to + TAP::Harness, and new options to prove, eg: + + prove --source XYZ --xyz-option foo=bar + + The new TAP::Parser::SourceHandler API makes it much easier to + write plugins. This breaks backwards compatibility for plugins & + extenstions that rely on the following APIs: + + TAP::Parser::Source + TAP::Parser::SourceFactory + TAP::Parser::IteratorFactory + TAP::Parser, specifically: + new: 'source' & 'tap' params + source_class + perl_source_class + iterator_factory_class + make_source + make_perl_source + make_iterator + + Please see the TAP::Parser docs for more details. + [Steve Purkis & David Wheeler] + - Removed dependency on File::Spec [Schwern] + - Made it possible to pass different args to each test [Lee Johnson] + - Added HARNESS_SUBCLASS option to Test::Harness + - Added TAP::Parser::SourceHandler::File which lets you to stream TAP + from a text file (eg: *.tap). + - Added TAP::Parser::SourceHandler::pgTAP. All the source handlers are + new, but this is the only one to add major new functioality: the + ability to run pgTAP tests (http://pgtap.projects.postgresql.org/). + +3.17 2009-05-05 + - Changed the 'failures' so that it is overridden by verbosity rather + than the other way around. + - Added the 'comments' option, most useful when used in conjunction + with the 'failures' option. + - Deprecated support for Perls earlier than 5.6.0. + - Allow '-I lib' as well as '-Ilib' in $Test::Harness::Switches + (regression). + - Restore old skip parsing semantics for TAP < v13. Refs #39031. + - Numerous small documentation fixes. + - Remove support for fork-based parallel testing. Multiplexed + parallel testing remains. + +3.16 2009-02-19 + - Fix path splicing on platforms where the path separator + is not ':'. + - Fixes/skips for failing Win32 tests. + - Don't break with older CPAN::Reporter versions. + +3.15 2009-02-17 + - Refactor getter/setter generation into TAP::Object. + - The App::Prove::State::Result::Test now stores the parser object. + - After discussion with Andy, agreed to clean up the test output + somewhat. t/foo.....ok becomes t/foo.t ... ok + - Make Bail out! die instead of exiting. Dies with the same + message as 2.64 for (belated) backwards compatibility. + - Alex Vaniver's patch to refactor TAP::Formatter::Console into + a new class, TAP::Formatter::File and a common base class: + TAP::Formatter::Base. + - Fix a bug where PERL5LIB might be put in the wrong spot in @INC. + #40257 + - Steve Purkis implemented a plugin mechanism for App::Prove. + +3.14 2008-09-13 + - Created a proper (ha!) API for prove state results and tests. + - Added --count and --nocount options to prove to control X/Y display + while running tests. + - Added 'fresh' state option to run test scripts that have been + touched since the test run. + - fixed bug where PERL5OPT was not properly split + - fixed regex in _filtered_inc. Fixes #39248. Thanks Slaven. + +3.13 2008-07-27 + - fixed various closure related leaks + - made prove honour HARNESS_TIMER + - Applied patches supplied by Alex Vandiver + - add 'rules' switch to prove: allows parallel execution rules + to be specified on the command line. + - allow '**' (any path) wildcard in parallel rules + - fix bug report address + - make tprove_gtk example work again. + +3.12 2008-06-22 + - applied Steve Purkis' huge refactoring patch which adds + configurable factories for most of the major internal classes. + - applied David Wheeler's patch to allow exec to be a code + reference. + - made tests more robust in the presence of -MFoo in PERL5OPT. + +3.11 2008-06-09 + - applied Jim Keenan's patch that makes App::Prove::run return a + rather than exit (#33609) + - prove -r now recurses cwd rather than 't' by default (#33007) + - restored --ext switch to prove (#33848) + - added ignore_exit option to TAP::Parser and corresponding + interfaces to TAP::Harness and Test::Harness. Requested for + Parrot. + - Implemented rule based parallel scheduler. + - Moved filename -> display name mapping out of formatter. This + prevents the formatter's strip-extensions logic from stripping + extensions from supplied descriptions. + - Only strip extensions from test names if all tests have the + same extension. Previously we stripped extensions if all names + had /any/ extension making it impossible to distinguish tests + whose name differed only in the extension. + - Removed privacy test that made it impossible to subclass + TAP::Parser. + - Delayed initialisation of grammar making it easier to replace + the TAP::Parser stream after instantiation. + - Make it possible to supply import parameters to a replacement + harness with prove. + - Make it possible to replace either _grammar /or/ _stream + before reading from a TAP::Parser. + +3.10 2008-02-26 + - fix undefined value warnings with bleadperl. + - added pragma support. + - fault unknown TAP tokens under strict pragma. + +3.09 2008-02-10 + - support for HARNESS_PERL_SWITCHES containing things like + '-e "system(shift)"'. + - set HARNESS_IS_VERBOSE during verbose testing. + - documentation fixes. + +3.08 2008-02-08 + - added support for 'out' option to + Test::Harness::execute_tests. See #32476. Thanks RENEEB. + - Fixed YAMLish handling of non-alphanumeric hash keys. + - Added --dry option to prove for 2.64 compatibility. + +3.07 2008-01-13 + - prove now supports HARNESS_PERL_SWITCHES. + - restored TEST_VERBOSE to prove. + +3.06 2008-01-01 + - Skip t/unicode.t if PERL_UNICODE set. Fixes #31731. + Thanks Lukas. + - App::Prove::State no longer complains about tests that + are deleted. + - --state=new and --state=old now consider the modification time + of test scripts. + - Made test suite core-compatible. + +3.05 2007-12-09 + - Skip unicode.t if Encode unavailable + - Support for .proverc files. + - Clarified prove documentation. + +3.04 2007-12-02 + - Fixed output leakage with really_quiet set. + - Progress reports for tests without plans now show + "143/?" instead of "143/0". + - Made TAP::Harness::runtests support aliases for test names. + - Made it possible to pass command line args to test programs + from prove, TAP::Harness, TAP::Parser. + - Added --state switch to prove. + +3.03 2007-11-17 + - Fixed some little bugs-waiting-to-happen inside + TAP::Parser::Grammar. + - Added parser_args callback to TAP::Harness. + - Made @INC propagation even more compatible with 2.64 so that + parrot still works *and* #30796 is fixed. + +3.02 2007-11-15 + - Process I/O now unbuffered, uses sysread, plays better with + select. Fixes #30740. + - Made Test::Harness @INC propagation more compatible with 2.64. + Was breaking Parrot's test suite. + - Added HARNESS_OPTIONS (#30676) + +3.01 2007-11-12 + - Fix for RHEL incpush.patch related failure. + - Output real time of test completion with --timer + - prove -b adds blib/auto to @INC + - made SKIP plan parsing even more liberal for pre-v13 TAP + +3.00 2007-11-06 + - Non-dev release. No changes since 2.99_09. + +2.99_09 2007-11-05 + - Implemented TODO-in-PLAN syntax for TAP version 12 and earlier. + +2.99_08 2007-11-04 + - Tiny changes. New version pushed to get some smoke coverage. + +2.99_07 2007-11-01 + - Fix for #21938: Unable to handle circular links + - Fix for #24926: prove -b and -l should use absolute paths + - Fixed prove switches. Big oops. How the hell did we miss that? + - Consolidated quiet, really_quiet, verbose into verbosity. + - Various VMS related fixes to tests + +2.99_06 2007-10-30 + - Added skip_all method to TAP::Parser. + - Display reason for skipped tests. + - make test now self tests. + +2.99_05 2007-10-30 + - Fix for occasional rogue -1 exit code on Windows. + - Fix for @INC handling under CPANPLUS. + - Added real time to prove --timer output + - Improved prove error message in case where 't' not found and + no tests named. + +2.99_04 2007-10-11 + - Fixed bug where 'All tests successful' would not be printed if bonus + tests are seen. + - Fixed bug where 'Result: FAIL' would be printed at the end of a test + run if there were unexpectedly succeeding tests. + - Added -M, -P switches to allow arbitrary modules to be loaded + by prove. We haven't yet defined what they'll do once they + load but it's a start... + - Added testing under simulated non-forking platforms. + +2.99_03 2007-10-06 + - Refactored all display specific code out of TAP::Harness. + - Relaxed strict parsing of skip plan for pre v13 TAP. + - Elapsed hi-res time is now displayed in integer milliseconds + instead of fractional seconds. + - prove stops running if any command-line switches are invalid. + - prove -v would try to print an undef. + - Added support for multiplexed and forked parallel tests. Use + prove -j 9 to run tests in parallel and prove -j 9 --fork to + fork. These features are experimental and currently + unavailable on Windows. + - Rationalized the management of the environment that we give to + test scripts (PERL5LIB, PERL5OPT, switches). + - Fixed handling of STDIN (we no longer close it) for test + scripts. + - Performance enhancements. Parser is now 30% - 40% faster. + +2.99_02 2007-09-07 + - Ensure prove (and App::Prove) sort any recursively + discovered tests + - It is now possible to register multiple callback handlers for + a particular event. + - Added before_runtests, after_runtests callbacks to + TAP::Harness. + - Moved logic of prove program into App::Prove. + - Added simple machine readable summary. + - Performance improvement: The processing pipeline within + TAP::Parser is now a closure which speeds up access to the + various attribtes it needs. + - Performance improvement: Test count spinner now updates + exponentially less frequently as the count increases which + saves a lot of I/O on big tests. + - More improvements in test coverage from Leif. + - Fixes to TAP spooling - now captures YAML blocks correctly. + - Fix YAMLish handling of empty arrays, hashes. + - Renamed TAP::Harness::Compatible to Test::Harness, + runtests to prove. + - Fixes to @INC handling. We didn't always pass the correct path + to subprocesses. + - We now observe any switches in HARNESS_PERL_SWITCHES. + - Changes to output formatting for greater compatibility with + Test::Harness 2.64. + - Added unicode test coverage and fixed a couple of + unicode issues. + - Additions to documentation. + - Added support for non-forking Perls. If forking isn't + available we fall back to open and disable stream merging. + - Added support for simulating non-forking Perls to improve our + test coverage. + +======================================================================== +Version numbers below this point relate to TAP::Parser - which was the +name of this version of Test::Harness during its development. +======================================================================== + +0.54 + - Optimized I/O for common case of 'runtests -l' + - Croak if supplied an empty (0 lines) Perl script. + - Made T::P::Result::YAML return literal input YAML correctly. + - Merged speed-ups from speedy branch. + +0.53 18 August 2007 + - Fixed a few docs nits. + - Added -V (--version) switch to runtests. Suggested by markjugg on + Perlmonks. + - Fixed failing t/030-grammer.t under 5.9.5. Exact cause still + unknown; something to do with localisation of $1 et all I think. + - Fixed use of three arg open in t/compat/test-harness-compat; was + failing on 5.6.2. + - Fixed runtests --exec option. T::H wasn't passing the exec option + to T::P. + - Merged Leif Eriksen's coverage enhancing changes to + t/080-aggregator.t, t/030-grammar.t + - Made various changes so that we test cleanly on 5.0.5. + - Many more coverage enhancements by Leif. + - Applied Michael Peters' patch to add an EOF callback to + TAP::Parser. + - Added --reverse option to runtests to run tests in reverse order. + - Made runtests exit with non-zero status if the test run had + problems. + - Stopped TAP::Parser::Iterator::Process from trampling on STDIN. + +0.52 14 July 2007 + - Incorporate Schwern's investigations into TAP versions. + Unversioned TAP is now TAP v12. The lowest explicit version number + that can be specified is 13. + - Renumbered tests to eliminate gaps. + - Killed execrc. The '--exec' switch to runtests handles all of this for + us. + - Refactored T::P::Iterator into + T::P::Iterator::(Array|Process|Stream) so that we have a + process specific iterator with which to experiment with + STDOUT/STDERR merging. + - Removed vestigial exit status handling from T::P::I::Stream. + - Removed unused pid interface from T::P::I::Process. + - Fixed infinite recursion in T::P::I::Stream and added regression + coverage for same. + - Added tests for T::P::I::Process. + - TAP::Harness now displays the first five TAP syntax errors and + explains how to pass the -p flag to runtests to see them all. + - Added merge option to TAP::Parser::Iterator::Process, + TAP::Parser::Source, TAP::Parser and TAP::Harness. + - Added --merge option to runtests to enable STDOUT/STDERR merging. + This behaviour used to be the default. + - Made T::P::I::Process use open3 for both merged and non-merged + streams so that it works on Windows. + - Implemented Eric Wilhelm's IO::Select based multiple stream + handler so that STDERR is piped to us even if stream merging is + turned off. This tends to reduce the temporal skew between the + two streams so that error messages appear closer to their + correct location. + - Altered the T::P::Grammar interface so that it gets a stream + rather than the next line from the stream in preparation for + making it handle YAML diagnostics. + - Implemented YAML syntax. Currently YAML may only follow a + test result. The first line of YAML is '---' and the last + line is '...'. + - Made grammar version-aware. Different grammars may now be selected + depending on the TAP version being parsed. + - Added formatter delegate mechanism for test results. + - Added prototype stream based YAML(ish) parser. + - Added more tests for T::P::YAMLish + - Altered T::P::Grammar to use T::P::YAMLish + - Removed T::P::YAML + - Added raw source capture to T::P::YAMLish + - Added support for double quoted hash keys + - Added TAP::Parser::YAMLish::Writer and renamed T::P::YAMLish as + T::P::YAMLish::Reader. + - Added extra TAP::Parser::YAMLish::Writer output options + - Inline YAML documents must now be indented by at least one space + - Fixed broken dependencies in bin/prove + - Make library paths absolute before running tests in case tests + chdir before loading modules. + - Added libs and switches handling to T::H::Compatible. This and the + previous change fix [24926] + - Added PERLLIB to libraries stripped in _default_inc [12030] + - Our version of prove now handles directories containing circular + links correctly [21938] + - Set TAP_VERSION env var in Parser [11595] + - Added setup, teardown hooks to T::P::I::Process to facilitate the + setup and cleanup of the test script's environment + - Any additional libs added to the command line are also added to + PERL5LIB for the duration of a test run so that any Perl children + of the test script inherit the same library paths. + - Fixed handling of single quoted hash keys in T::P::Y::Reader + - Made runtests return the TAP::Parser::Aggregator + - Fixed t/120-harness.t has failures if TAP::Harness::Color cannot + load optional modules [27125] - thanks DROLSKY + - Fixed parsing of \# in test description +0.51 12 March 2007 + - 'execrc' file now allows 'regex' matches for tests. + - rename 'TAPx' --> 'TAP' + - Reimplemented the parse logic of TAP::Parser as a state machine. + - Removed various ad-hoc state variables from TAP::Parser and moved + their logic into the state machine. + - Removed now-unused is_first / is_last methods from Iterator and + simplified remaining logic to suit. + - Removed now-redundant t/140-varsource.t. + - Implemented TAP version syntax. + - Tidied TAP::Harness::Compatible documentation + - Removed redundant modules below TAP::Harness::Compatible + - Removed unused compatibility tests + +0.50_07 5 March 2007 + - Fixed bug where we erroneously checked the test number instead of number + of tests run to determine if we've run more tests than we planned. + - Add a --directives switch to 'runtests' which only shows test results + with directives (such as 'TODO' or 'SKIP'). + - Removed some dead code from TAPx::Parser. + - Added color support for Windows using Win32::Console. + - Made Color::failure_output reset colors before printing + the trailing newline. + - Corrected some issues with the 'runtests' docs and removed some + performance notes which no longer seem accurate. + - Fixed bug whereby if tests without file extensions were included then + the spacing of the result leaders would be off. + - execrc file is now a YAML file. + - Removed white background on the test failures. It was too garish for + me. Just more proof that we need better ways of overriding color + support. + - Started work on TAPx::Harness::Compatible. Right now it's mainly just + a direct lift of Test::Harness to make sure the tests work. + - Commented out use Data::Dumper::Simple in T::Harness.pm - it's not + a core module. + - Added next_raw to TAPx::Parser::Iterator which skips any fixes for + quirky TAP that are implemented by next. Used to support + TAPx::Harness::Compatible::Iterator + - Applied our version number to all T::H::Compatible modules + - Removed T::H::C::Assert. It's documented as being private to + Test::Harness and we're not going to need it. + - Refactored runtests to call aggregate_tests to expose the + interface we need for the compatibility layer. + - Make it possible to pass an end time to summary so that it needn't + be called immediately after the tests complete. + - Moved callback handling into TAPx::Base and altered TAPx::Parser + to use it. + - Made TAPx::Harness into a subclass of TAPx::Base and implemented + made_parser callback. + - Moved the dispatch of callbacks out of run and into next so that + they're called when TAPx::Harness iterates through the results. + - Implemented PERL_TEST_HARNESS_DUMP_TAP which names a directory + into which the raw TAP of any tests run via TAPx::Harness will + be written. + - Rewrote the TAPx::Grammar->tokenize method to return a + TAPx::Parser::Result object. Code is much cleaner now. + - Moved the official grammar from TAPx::Parser to TAPx::Parser::Grammar, + provided a link and updated the grammar. + - Fixed bug where a properly escaped '# TODO' line in a test description + would still be reported as a TODO test. + - Added patches/ExtUtils-MakeMaker-6.31.patch - a patch against EUMM + that makes test_harness use TAPx::Harness instead of Test::Harness + if PERL_EUMM_USE_TAPX is true and TAPx::Harness is installed. In + other words cause 'make test' for EUMM based models to use + TAPx::Harness. + - Added support for timer option to TAPx::Harness which causes the + elapsed time for each test to be displayed. + - Setup tapx-dev@hexten.net mailing list. + - Fixed accumulating @$exec bug in TAPx::Harness. + - Made runtests pass '--exec' option as an array. + - (#24679) TAPx::Harness now reports failure for tests that die + after completing all subtests. + - Added in_todo attribute on TAPx::Parser which is true while the + most recently seen test was a TODO. + - (#24728) TAPx::Harness now supresses diagnostics from failed + TODOs. Not sure if the semantics of this are correct yet. + +0.50_06 18 January 2007 + - Fixed doc typo in examples/README [rt.cpan.org #24409] + - Colored test output is now the default for 'runtests' unless + you're running under windows or -t STDOUT is false. + [rt.cpan.org #24310] + - Removed the .t extension from t/source_tests/*.t since those are + 'test tests' which caused false negatives when running recursive + tests. [Adrian Howard] + - Somewhere along the way, the exit status started working again. + Go figure. + - Factored color output so that disabling it under Windows is + cleaner. + - Added explicit switch to :crlf layer after open3 under Windows. + open3 defaults to raw mode resulting in spurious \r characters input + parsed input. + - Made Iterator do an explicit wait for subprocess termination. + Needed to get process status correctly on Windows. + - Fixed bug which didn't allow t/010-regression.t to be run directly + via Perl unless you specified Perl's full path. + - Removed SIG{CHLD} handler (which we shouldn't need I think because + we explicitly waitpid) and made binmode ':crlf' conditional on + IS_WIN32. On Mac OS these two things combined to expose a problem + which meant that output from test scripts was sometimes lost. + - Made t/110-source.t use File::Spec->catfile to build path to + test script. + - Made Iterator::FH init is_first, is_last to 0 rather than undef + for consistency with array iterator. + - Added t/120-varsource.t to test is_first and is_last semantics + over files with small numbers of lines. + - Added check for valid callback keys. + - Added t/130-results.t for Result classes. + +0.50_05 15 January 2007 + - Removed debugging code accidentally left in bin/runtests. + - Removed 'local $/ = ...' from the iterator. Hopefully that will fix the + line ending bug, but I don't know about the wstat problem. + +0.50_04 14 January 2007 + - BACKWARDS IMCOMPATIBLE: Renamed all '::Results' classes to '::Result' + because they represent a single result. + - Fixed bug where piping would break verbose output. + - IPC::Open3::open3 now takes a @command list rather than a $command + string. This should make it work under Windows. + - Added 'stdout_sterr' sample test back to regression tests. IPC::Open3 + appears to make it work. + - Bug fix: don't print 'All tests successful' if no tests are run. + - Refactored 'runtests' to make it a bit easier to follow. + - Bug fix: Junk and comments now allowed before a leading plan. + - HARNESS_ACTIVE and HARNESS_VERSION environment variables now set. + - Renamed 'problems' in TAPx::Parser and TAPx::Aggregator to + 'has_problems'. + +0.50_03 08 January 2007 + + - Fixed bug where '-q' or '-Q' with colored tests weren't suppressing all + information. + - Fixed an annoying MANIFEST nit. + - Made '-h' for runtests now report help. Using a new harness requires + the full --harness switch. + - Added 'problems' method to TAPx::Parser and TAPx::Parser::Aggregator. + - Deprecatd 'todo_failed' in favor of 'todo_passed' + - Add -I switch to runtests. + - Fixed runtests doc nit (smylers) + - Removed TAPx::Parser::Builder. + - A few more POD nits taken care of. + - Completely removed all traces of C<--merge> as IPC::Open3 seems to be + working. + - Moved the tprove* examples to examples/bin in hopes of them no longer + showing up in CPAN's docs. + - Made the 'unexpectedly succeeded' message clearer (Adam Kennedy) + +0.50_02 06 January 2007 + - Added some files I left out of the manifest (reported by Florian + Ragwitz). + - Added strict to Makefile.PL and changed @PROGRAM to @program (reported + Florian Ragwitz). + +0.50_01 06 January 2007 + - Added a new example which shows to how test Perl, Ruby, and URLs all at + the same time using 'execrc' files. + - Fixed the diagnostic format mangling bug. + - We no longer override Test::Builder to merge streams. Instead, we go + ahead and use IPC::Open3. It remains to be seen whether or not this is + a good idea. + - Fixed vms nit: for failing tests, vms often has the 'not' on a line by + itself. + - Fixed bugs where unplanned tests were not reporting as a failure (test + number greater than tests planned). + - TAPx::Parser constructor can now take an 'exec' option to tell it what + to execute to create the stream (huge performance boost). + - Added TAPx::Parser::Source. This allows us to run tests in just about + any programming language. + - Renamed the filename() method to source() in TAPx::Parser::Source::Perl. + - We now cache the @INC values found for TAPx::Parser::Source::Perl. + - Added two test harnesses, TAPx::Harness and TAPx::Harness::Color. + - Removed references to manual stream construction from TAPx::Parser + documentation. Users should not (usually) need to worry about streams. + - Added bin/runtests utility. This is very similar to 'prove'. + - Renumbered tests to make it easier to add new ones. + - Corrected some minor documentation nits. + - Makefile.PL is no longer auto-generated (it's built by hand). + - Fixed regression test bug where driving tests through the harness I'm + testing caused things to break. + - BUG: exit() values are now broken. I don't know how to capture them + with IPC::Open3. However, since no one appears to be using them, this + might not be an issue. + +0.41 12 December 2006 + - Fixed (?) 10-regression.t test which failed on Windows. Removed the + segfault test as it has no meaning on Windows. Reported by PSINNOTT + and fix recommended by Schwern based on his + Test::Harness experience. + http://rt.cpan.org/Ticket/Display.html?id=21624 + +0.40 05 December 2006 + - Removed TAPx::Parser::Streamed and folded its functionality into + TAPx::Parser. + - Fixed bug where sometimes is_good_plan() would return a false positive + (exposed by refactoring). + - A number of tiny performance enhancements. + +0.33 22 September 2006 + - OK, I'm getting ticked off by some of the comments on Perl-QA so I + rushed this out the door and broke it :( I'm backing out one test and + slowing down a bit. + +0.32 22 September 2006 + - Applied patch from Schwern which fixed the Builder package name (TAPx:: + instead of TAPX:: -- stupid case-insensitive package names!). + [rt.cpan.org #21605] + +0.31 21 September 2006 + - Fixed bug where Carp::croak without parens could cause Perl to fail to + compile on some platforms. [Andreas J. Koenig] + - Eliminated the non-portable redirect of STDERR to STDOUT (2>&1) and + fixed the synchronization issue. This involves overridding + Test::Builder::failure_output() in a very sneaky way. I may have to + back this out. + - Renamed boolean methods to begin with 'is_'. The methods they replace + are documented, deprecated, and will not be removed prior to version + 1.00. + +0.30 17 September 2006 + - Fixed bug where no output would still claim to have a good plan. + - Fixed bug where no output would cause parser to die. + - Fixed bug where failing to specify a plan would be two parse errors + instead of one. + - Fixed bug where a correct plan count in an incorrect place would still + report as a 'good_plan'. + - Fixed bug where comments could accidently be misparsed as directives. + - Eliminated testing of internal structure of result objects. The other + tests cover this. + - Allow hash marks in descriptions. This was causing a problem because + many test suites (Regexp::Common and Perl core) allowed them to exist. + - Added support for SKIP directives in plans. + - Did some work simplifying &TAPx::Parser::_initialize. It's not great, + but it's better than it was. + - TODO tests now always pass, regardless of actual_passed status. + - Removed 'use warnings' and now use -w + - 'switches' may now be passed to the TAPx::Parser constructor. + - Added 'exit' status. + - Added 'wait' status. + - Eliminated 'use base'. This is part of the plan to make TAPx::Parser + compatible with older versions of Perl. + - Added 'source' key to the TAPx::Parser constructor. Making new parsers + is now much easier. + - Renamed iterator first() and last() methods to is_first() and is_last(). + Credit: Aristotle. + - Planned tests != tests run is now a parse error. It was really stupid + of me not to do that in the first place. + - Added massive regression test suite in t/100-regression.t + - Updated the grammar to show that comments are allowed. + - Comments are now permitted after an ending plan. + +0.22 13 September 2006 + - Removed buggy support for multi-line chunks from streams. If your + streams or iterators return anything but single lines, this is a bug. + - Fixed bug whereby blank lines in TAP would confuse the parser. Reported + by Torsten Schoenfeld. + - Added first() and last() methods to the iterator. + - TAPx::Parser::Source::Perl now has a 'switches' method which allows + switches to be passed to the perl executable running the test file. + This allows tprove to accept a '-l' argument to force lib/ to be + included in Perl's @INC. + +0.21 8 September 2006 + - Included experimental GTK interface written by Torsten Schoenfeld. + - Fixed bad docs in examples/tprove_color + - Applied patch from Shlomi Fish fixing bug where runs from one stream + could leak into another when bailing out. [rt.cpan.org #21379] + - Fixed some typos in the POD. + - Corrected the grammar to allow for a plan of "1..0" (infinite stream). + - Started to add proper acknowledgements. + +0.20 2 September 2006 + - Fixed bug reported by GEOFFR. When no tap output was found, an + "Unitialized value" warning occurred. [rt.cpan.org #21205] + - Updated tprove to now report a test failure when no tap output found. + - Removed examples/tprove_color2 as tprove_color now works. + - Vastly improved callback system and updated the docs for how to use + them. + - Changed TAPx::Parser::Source::Perl to use Symbol::gensym() instead of a + hard-to-guess filehandle name. + +0.12 30 July 2006 + - Added a test colorization script + - Callback support added. + - Added TAPx::Parser::Source::Perl. + - Added TAPx::Parser::Aggregator. + - Added version numbers to all classes. + - Added 'todo_failed' test result and parser. + - 00-load.t now loads all classes instead of having individual tests load + their supporting classes. + - Changed $parser->results to $parser->next + +0.11 25 July, 2006 + - Renamed is_skip and is_todo to has_skip and has_todo. Much less + confusing since a result responding true to those also responded true to + is_test. + - Added simplistic bin/tprove to run tests. Much harder than I thought + and much code stolen from Test::Harness. + - Modified stolen iterator to fix a bug with stream handling when extra + newlines were encountered. + - Added TAPx::Parser::Iterator (stolen from Test::Harness::Iterator) + - Normalized internal structure of result objects. + - All tokens now have a 'type' key. This greatly simplifies internals. + - Copied much result POD info into the main docs. + - Corrected the bug report URLs. + - Minor updates to the grammar listed in the POD. + +0.10 23 July, 2006 + - Oh my Larry, we gots docs! + - _parse and _tap are now private methods. + - Stream support has been added. + - Moved the grammar into its own class. + - Pulled remaining parser functionality out of lexer. + - Added type() method to Results(). + - Parse errors no longer croak(). Instead, they are available through the + parse_errors() method. + - Added good_plan() method. + - tests_planned != tests_run is no longer a parse error. + - Renamed test_count() to tests_run(). + - Renamed num_tests() to tests_planned(). + +0.03 17 July, 2006 + - 'Bail out!' is now handled. + - The parser is now data driven, thus skipping a huge if/else chain + - We now track all TODOs, SKIPs, passes and fails by test number. + - Removed all non-core modules. + - Store original line for each TAP line. Available through + $result->raw(). + - Renamed test is_ok() to passed() and added actual_passed(). The former + method takes into account TODO tests and the latter returns the actual + pass/fail status. + - Fixed a bug where SKIP tests would not be identified correctly. + +0.02 8 July, 2006 + - Moved some lexer responsibility to the parser. This will allow us to + eventually parse streams. + - Properly track passed/failed tests, even accounting for TODO. + - Added support for comments and unknown lines. + - Allow explicit and inferred test numbers to be mixed. + - Allow escaped hashes in the test description. + - Renamed to TAPx::Parser. Will probably rename it again. + +0.01 Date/time + - First version, unreleased on an unsuspecting world. + - No, you'll never know when ... diff --git a/Changes-2.64 b/Changes-2.64 new file mode 100644 index 0000000..37710b8 --- /dev/null +++ b/Changes-2.64 @@ -0,0 +1,731 @@ +Revision history for Perl extension Test::Harness + +This is the revision history for the previous version of Test::Harness +up to 2.64. The current version of test harness is a complete rewrite of +this code. + +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 --git a/HACKING.pod b/HACKING.pod new file mode 100644 index 0000000..81aec9b --- /dev/null +++ b/HACKING.pod @@ -0,0 +1,264 @@ + +# this is in pod format (try `perldoc HACKING.pod`) + +=pod + +=head1 NAME + +HACKING.pod - contributing to TAP::Harness + +=head1 ABOUT + +This is the guide for TAP::Harness internals contributors (developers, +testers, documenters.) + +If you are looking for more information on how to I TAP::Harness, +you probably want +L +instead. + +=head1 Getting Started + +See the resources section in I or I for links to the +project mailing list, bug tracker, svn repository, etc. + +For ease of reference, at the time of writing the SVN repository was at: + + http://svn.hexten.net/tapx + +To get the latest version of trunk: + + git clone git://github.com/Perl-Toolchain-Gang/Test-Harness.git + +For best results, read the rest of this file, check RT for bugs which +scratch your itch, join the mailing list, etc. + +=head1 Formatting + +=head2 perltidy + +The project comes with a C<.perltidyrc>, which perltidy will +automatically use if the project root is your working directory. This +is setup by default to read and write the perl code on a pipe. To +configure your editor: + +=over 4 + +=item * vim + +In C<.vimrc>, you can add the following lines: + + nnoremap pt :%!perltidy -q " only work in 'normal' mode + vnoremap pt :!perltidy -q " only work in 'visual' mode + +In other words, if your C is a backslash, you can type C<\pt> to +reformat the file using the C<.perltidyrc>. If you are in visual mode +(selecting lines with shift-v), then only the code you have currently have +selected will be reformatted. + +=item * emacs + +For emacs, you can use this snippet from Sam Tregar +(L): + + (defun perltidy-region () + "Run perltidy on the current region." + (interactive) + (save-excursion + (shell-command-on-region (point) (mark) "perltidy -q" nil t) + (cperl-mode))) + + (defun perltidy-all () + "Run perltidy on the current region." + (interactive) + (let ((p (point))) + (save-excursion + (shell-command-on-region (point-min) (point-max) "perltidy -q" nil t) + ) + (goto-char p) + (cperl-mode))) + + (global-set-key "\M-t" `perltidy-region) + (global-set-key "\M-T" `perltidy-all) + +=back + +=head1 Tests and Coverage + +... + +=for eric_not_it + TODO link to a good guide on writing tests for TAP::Parser + +=head1 Writing for Compatibility + +... + +=for eric_not_it + TODO explain no bundling, PERL_CORE, etc + +=head1 Use TAP::Object + +TAP::Object is the common base class to all TAP::* modules, and should be for +any that you write. + +=head1 Exception Handling + +Exceptions should be raised with L: + + require Carp; + Carp::croak("Unsupported syntax version: $version"); + + require Carp; + Carp::confess("Unsupported syntax version: $version"); + +=head1 Deprecation cycle + +Any I sub that needs to be changed or removed (and would therefore +cause a backwards-compat issue) must go through a deprecation cycle to give +developers a chance to adjust: + + 1. Document the deprecation + 2. Carp a suitable message + 3. Release + 4. Change the code + 5. Release + +=head1 Documentation + +The end-user and API documentation is all in the 'lib/' directory. In +.pm files, the pod is "inline" to the code. See L for more +about pod. + +=head2 Pod Commands + +For compatibility's sake, we do not use the =head3 and =head4 commands. + +=over + +=item C<=head1 SECTION> + +Sections begin with an C<=head1> command and are all-caps. + +=for eric_not_it + I guess... Mixed case messes with various pod hacking tools. + + NAME + VERSION + SYNOPSIS + CONSTRUCTOR + METHODS + CLASS METHODS + SOME OTHER SORT OF METHODS + SEE ALSO + +=item C<=head2 method> + +=for eric_not_it + The following is how I would do it, but opposite of what we have. + +The C<=head2> command documents a method. The name of the method should have no adornment (e.g. don't CEmethod> or CEmethod($list, $of, $params)>.) + +These sections should begin with a short description of what the method +does, followed by one or more examples of usage. If needed, elaborate +on the subtleties of the parameters and context after (and/or between) +the example(s). + + =head2 this_method + + This method does some blah blah blah. + + my @answer = $thing->this_method(@arguments); + + =head2 that_thing + + Returns true if the thing is true. + + if($thing->that_thing) { + ... + } + +=item C<=item parameter> + +Use C<=item> commands for method arguments and parameters (and etc.) In +most html pod formatters, these I get added to the +table-of-contents at the top of the page. + +=back + +=head2 Pod Formatting Codes + +=over + +=item LESome::Module> + +Be careful of the wording of CSome::ModuleE>. Older pod +formatters would render this as "the Some::Module manpage", so it is +best to either word your links as "C<(see ESome::ModuleE for +details.)>" or use the "explicit rendering" form of +"CSome::Module|Some::ModuleE>". + +=back + +=head2 VERSION + +The version numbers are updated by L. + +=head2 DEVELOPER DOCS/NOTES + +The following "formats" are used with C<=begin>/C<=end> and C<=for> +commands for pod which is not part of the public end-user/API +documentation. + +=over + +=item note + +Use this if you are uncertain about a change to some pod or think it +needs work. + + =head2 some_method + + ... + + =for note + This is either falsely documented or a bug -- see ... + +=item developer + + =begin developer + + Long-winded explanation of why some code is the way it is or various + other subtleties which might incite head-scratching and WTF'ing. + + =end developer + +=item deprecated + + =for deprecated + removed in 0.09, kill by ~0.25 + +=back + +=head1 Committing to Subversion + +If you have commit access, please bear this in mind. + +Development is done either on trunk or a branch, as appropriate: + +If it's something that might be controversial, break the build or take a long +time (more than a couple of weeks) to complete then it'd probably be +appropriate to branch. Otherwise it can go in trunk. + +If in doubt discuss it on the mailing list before you commit. + +=cut + +=for developer +... or whatever. I'm just making stuff up here. If any of this is +wrong, please correct it. To the extent that there is an "official +policy", it should be written down. --Eric + +=cut + +# vim:ts=2:sw=2:et:sta diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..bd53a3a --- /dev/null +++ b/MANIFEST @@ -0,0 +1,232 @@ +bin/prove +Changes +Changes-2.64 +examples/analyze_tests.pl +examples/bin/forked_tests.pl +examples/bin/test_html.pl +examples/bin/tprove_gtk +examples/harness-hook/hook.pl +examples/harness-hook/lib/Harness/Hook.pm +examples/my_exec +examples/README +examples/silent-harness.pl +examples/t/10-stuff.t +examples/t/ruby.t +examples/test_urls.txt +HACKING.pod +lib/App/Prove.pm +lib/App/Prove/State.pm +lib/App/Prove/State/Result.pm +lib/App/Prove/State/Result/Test.pm +lib/TAP/Base.pm +lib/TAP/Formatter/Base.pm +lib/TAP/Formatter/Color.pm +lib/TAP/Formatter/Console.pm +lib/TAP/Formatter/Console/ParallelSession.pm +lib/TAP/Formatter/Console/Session.pm +lib/TAP/Formatter/File.pm +lib/TAP/Formatter/File/Session.pm +lib/TAP/Formatter/Session.pm +lib/TAP/Harness.pm +lib/TAP/Harness/Beyond.pod +lib/TAP/Harness/Env.pm +lib/TAP/Object.pm +lib/TAP/Parser.pm +lib/TAP/Parser/Aggregator.pm +lib/TAP/Parser/Grammar.pm +lib/TAP/Parser/Iterator.pm +lib/TAP/Parser/Iterator/Array.pm +lib/TAP/Parser/Iterator/Process.pm +lib/TAP/Parser/Iterator/Stream.pm +lib/TAP/Parser/IteratorFactory.pm +lib/TAP/Parser/Multiplexer.pm +lib/TAP/Parser/Result.pm +lib/TAP/Parser/Result/Bailout.pm +lib/TAP/Parser/Result/Comment.pm +lib/TAP/Parser/Result/Plan.pm +lib/TAP/Parser/Result/Pragma.pm +lib/TAP/Parser/Result/Test.pm +lib/TAP/Parser/Result/Unknown.pm +lib/TAP/Parser/Result/Version.pm +lib/TAP/Parser/Result/YAML.pm +lib/TAP/Parser/ResultFactory.pm +lib/TAP/Parser/Scheduler.pm +lib/TAP/Parser/Scheduler/Job.pm +lib/TAP/Parser/Scheduler/Spinner.pm +lib/TAP/Parser/Source.pm +lib/TAP/Parser/SourceHandler.pm +lib/TAP/Parser/SourceHandler/Executable.pm +lib/TAP/Parser/SourceHandler/File.pm +lib/TAP/Parser/SourceHandler/Handle.pm +lib/TAP/Parser/SourceHandler/Perl.pm +lib/TAP/Parser/SourceHandler/RawTAP.pm +lib/TAP/Parser/YAMLish/Reader.pm +lib/TAP/Parser/YAMLish/Writer.pm +lib/Test/Harness.pm +Makefile.PL +MANIFEST +MANIFEST.CUMMULATIVE +META.json +META.yml +perlcriticrc +README +t/000-load.t +t/aggregator.t +t/bailout.t +t/base.t +t/callbacks.t +t/compat/env.t +t/compat/env_opts.t +t/compat/failure.t +t/compat/inc-propagation.t +t/compat/inc_taint.t +t/compat/nonumbers.t +t/compat/regression.t +t/compat/subclass.t +t/compat/switches.t +t/compat/test-harness-compat.t +t/compat/version.t +t/console.t +t/data/catme.1 +t/data/proverc +t/data/sample.yml +t/env_opts.t +t/errors.t +t/file.t +t/glob-to-regexp.t +t/grammar.t +t/harness-bailout.t +t/harness-subclass.t +t/harness.t +t/iterator_factory.t +t/iterators.t +t/lib/App/Prove/Plugin/Dummy.pm +t/lib/App/Prove/Plugin/Dummy2.pm +t/lib/Dev/Null.pm +t/lib/EmptyParser.pm +t/lib/if.pm +t/lib/IO/c55Capture.pm +t/lib/MyCustom.pm +t/lib/MyFileSourceHandler.pm +t/lib/MyGrammar.pm +t/lib/MyIterator.pm +t/lib/MyPerlSourceHandler.pm +t/lib/MyResult.pm +t/lib/MyResultFactory.pm +t/lib/MySourceHandler.pm +t/lib/NoFork.pm +t/lib/NOP.pm +t/lib/TAP/Harness/TestSubclass.pm +t/lib/TAP/Parser/SubclassTest.pm +t/multiplexer.t +t/nested.t +t/nofork-mux.t +t/nofork.t +t/object.t +t/parse.t +t/parser-config.t +t/parser-subclass.t +t/perl5lib.t +t/premature-bailout.t +t/process.t +t/prove.t +t/proverc.t +t/proverc/emptyexec +t/proverun.t +t/proveversion.t +t/regression.t +t/results.t +t/rulesfile.t +t/sample-tests/bailout +t/sample-tests/bignum +t/sample-tests/bignum_many +t/sample-tests/combined +t/sample-tests/combined_compat +t/sample-tests/delayed +t/sample-tests/descriptive +t/sample-tests/descriptive_trailing +t/sample-tests/die +t/sample-tests/die_head_end +t/sample-tests/die_last_minute +t/sample-tests/die_unfinished +t/sample-tests/duplicates +t/sample-tests/echo +t/sample-tests/empty +t/sample-tests/escape_eol +t/sample-tests/escape_hash +t/sample-tests/head_end +t/sample-tests/head_fail +t/sample-tests/inc_taint +t/sample-tests/junk_before_plan +t/sample-tests/lone_not_bug +t/sample-tests/no_nums +t/sample-tests/no_output +t/sample-tests/out_err_mix +t/sample-tests/out_of_order +t/sample-tests/schwern +t/sample-tests/schwern-todo-quiet +t/sample-tests/segfault +t/sample-tests/sequence_misparse +t/sample-tests/shbang_misparse +t/sample-tests/simple +t/sample-tests/simple_fail +t/sample-tests/simple_yaml +t/sample-tests/simple_yaml_missing_version13 +t/sample-tests/skip +t/sample-tests/skip_nomsg +t/sample-tests/skipall +t/sample-tests/skipall_nomsg +t/sample-tests/skipall_v13 +t/sample-tests/space_after_plan +t/sample-tests/space_after_plan_v13 +t/sample-tests/stdout_stderr +t/sample-tests/strict +t/sample-tests/switches +t/sample-tests/taint +t/sample-tests/taint_warn +t/sample-tests/todo +t/sample-tests/todo_inline +t/sample-tests/todo_misparse +t/sample-tests/too_many +t/sample-tests/version_good +t/sample-tests/version_late +t/sample-tests/version_old +t/sample-tests/vms_nit +t/sample-tests/with_comments +t/sample-tests/yaml_late_plan +t/sample-tests/zero_valid +t/scheduler.t +t/source.t +t/source_handler.t +t/source_tests/harness +t/source_tests/harness_badtap +t/source_tests/harness_complain +t/source_tests/harness_directives +t/source_tests/harness_failure +t/source_tests/psql.bat +t/source_tests/source +t/source_tests/source.1 +t/source_tests/source.bat +t/source_tests/source.pl +t/source_tests/source.sh +t/source_tests/source.t +t/source_tests/source.tap +t/source_tests/source_args.sh +t/source_tests/test.tap +t/spool.t +t/state.t +t/state_results.t +t/streams.t +t/subclass_tests/non_perl_source +t/subclass_tests/perl_source +t/taint.t +t/testargs.t +t/unicode.t +t/yamlish-output.t +t/yamlish-writer.t +t/yamlish.t +xt/author/pod-coverage.t +xt/author/pod.t +xt/author/stdin.t +xt/perls/harness_perl.t +xt/perls/sample-tests/perl_version diff --git a/MANIFEST.CUMMULATIVE b/MANIFEST.CUMMULATIVE new file mode 100644 index 0000000..c0e58b0 --- /dev/null +++ b/MANIFEST.CUMMULATIVE @@ -0,0 +1,333 @@ +.perltidyrc +Build.PL +Changes +Changes-2.64 +HACKING.pod +MANIFEST +MANIFEST.CUMMULATIVE +META.yml +Makefile.PL +NotBuild.PL +README +TODO +bin/prove +bin/runtests +examples/README +examples/analyze_tests.pl +examples/bin/forked_tests.pl +examples/bin/test_html.pl +examples/bin/tprove +examples/bin/tprove_color +examples/bin/tprove_gtk +examples/harness-hook/hook.pl +examples/harness-hook/lib/Harness/Hook.pm +examples/my_exec +examples/my_execrc +examples/silent-harness.pl +examples/t/10-stuff.t +examples/t/ruby.t +examples/tapx_harness_execrc +examples/test_urls.txt +inc/MyBuilder.pm +lib/App/Prove.pm +lib/App/Prove/State.pm +lib/App/Prove/State/Result.pm +lib/App/Prove/State/Result/Test.pm +lib/TAP/Base.pm +lib/TAP/Formatter/Base.pm +lib/TAP/Formatter/Color.pm +lib/TAP/Formatter/Console.pm +lib/TAP/Formatter/Console/ParallelSession.pm +lib/TAP/Formatter/Console/Session.pm +lib/TAP/Formatter/File.pm +lib/TAP/Formatter/File/Session.pm +lib/TAP/Formatter/Session.pm +lib/TAP/Harness.pm +lib/TAP/Harness/Beyond.pod +lib/TAP/Harness/Color.pm +lib/TAP/Harness/Compatible.pm +lib/TAP/Object.pm +lib/TAP/Parser.pm +lib/TAP/Parser/Aggregator.pm +lib/TAP/Parser/Grammar.pm +lib/TAP/Parser/Iterator.pm +lib/TAP/Parser/Iterator/Array.pm +lib/TAP/Parser/Iterator/Process.pm +lib/TAP/Parser/Iterator/Stream.pm +lib/TAP/Parser/IteratorFactory.pm +lib/TAP/Parser/Multiplexer.pm +lib/TAP/Parser/Result.pm +lib/TAP/Parser/Result/Bailout.pm +lib/TAP/Parser/Result/Comment.pm +lib/TAP/Parser/Result/Plan.pm +lib/TAP/Parser/Result/Pragma.pm +lib/TAP/Parser/Result/Test.pm +lib/TAP/Parser/Result/Unknown.pm +lib/TAP/Parser/Result/Version.pm +lib/TAP/Parser/Result/YAML.pm +lib/TAP/Parser/ResultFactory.pm +lib/TAP/Parser/Scheduler.pm +lib/TAP/Parser/Scheduler/Job.pm +lib/TAP/Parser/Scheduler/Spinner.pm +lib/TAP/Parser/Source.pm +lib/TAP/Parser/Source/Perl.pm +lib/TAP/Parser/SourceHandler.pm +lib/TAP/Parser/SourceHandler/Executable.pm +lib/TAP/Parser/SourceHandler/File.pm +lib/TAP/Parser/SourceHandler/Handle.pm +lib/TAP/Parser/SourceHandler/Perl.pm +lib/TAP/Parser/SourceHandler/RawTAP.pm +lib/TAP/Parser/Utils.pm +lib/TAP/Parser/YAML.pm +lib/TAP/Parser/YAMLish/Reader.pm +lib/TAP/Parser/YAMLish/Writer.pm +lib/TAPx/Base.pm +lib/TAPx/Harness.pm +lib/TAPx/Harness/Color.pm +lib/TAPx/Harness/Compatible.pm +lib/TAPx/Harness/Compatible/Iterator.pm +lib/TAPx/Harness/Compatible/Point.pm +lib/TAPx/Harness/Compatible/Results.pm +lib/TAPx/Harness/Compatible/Straps.pm +lib/TAPx/Harness/Compatible/TAP.pod +lib/TAPx/Harness/Compatible/Util.pm +lib/TAPx/Parser.pm +lib/TAPx/Parser/Aggregator.pm +lib/TAPx/Parser/Grammar.pm +lib/TAPx/Parser/Iterator.pm +lib/TAPx/Parser/Result.pm +lib/TAPx/Parser/Result/Bailout.pm +lib/TAPx/Parser/Result/Comment.pm +lib/TAPx/Parser/Result/Plan.pm +lib/TAPx/Parser/Result/Test.pm +lib/TAPx/Parser/Result/Unknown.pm +lib/TAPx/Parser/Source.pm +lib/TAPx/Parser/Source/Perl.pm +lib/TAPx/Parser/YAML.pm +lib/Test/Harness.pm +patches/ExtUtils-MakeMaker-6.31.patch +perlcriticrc +perltidyrc +t/000-load.t +t/010-base.t +t/010-regression.t +t/020-parse.t +t/020-regression.t +t/030-bailout.t +t/030-grammar.t +t/040-errors.t +t/040-parse.t +t/050-bailout.t +t/050-streams.t +t/060-aggregator.t +t/060-errors.t +t/070-callbacks.t +t/070-streams.t +t/080-aggregator.t +t/080-premature-bailout.t +t/090-callbacks.t +t/090-iterators.t +t/100-harness.t +t/100-premature-bailout.t +t/110-iterators.t +t/110-source.t +t/120-harness.t +t/130-source.t +t/140-results.t +t/140-varsource.t +t/150-results.t +t/150-yamlish.t +t/160-yaml.t +t/160-yamlish-writer.t +t/170-yamlish-output.t +t/180-unicode.t +t/190-nofork.t +t/200-prove.t +t/aggregator.t +t/bailout.t +t/base.t +t/callbacks.t +t/compat/000-compile.t +t/compat/00compile.t +t/compat/010-failure.t +t/compat/020-inc_taint.t +t/compat/030-nonumbers.t +t/compat/040-test-harness-compat.t +t/compat/060-version.t +t/compat/base.t +t/compat/callback.t +t/compat/env.t +t/compat/failure.t +t/compat/from_line.t +t/compat/harness.t +t/compat/inc-propagation.t +t/compat/inc_taint.t +t/compat/nonumbers.t +t/compat/ok.t +t/compat/point-parse.t +t/compat/point.t +t/compat/prove-globbing.t +t/compat/prove-switches.t +t/compat/regression.t +t/compat/strap-analyze.t +t/compat/strap.t +t/compat/subclass.t +t/compat/switches.t +t/compat/test-harness-compat.t +t/compat/test-harness.t +t/compat/version.t +t/console.t +t/data/catme.1 +t/data/execrc +t/data/proverc +t/data/sample.yml +t/errors.t +t/file.t +t/glob-to-regexp.t +t/grammar.t +t/harness-bailout.t +t/harness-subclass.t +t/harness.t +t/iterator_factory.t +t/iterators.t +t/lib/App/Prove/Plugin/Dummy.pm +t/lib/App/Prove/Plugin/Dummy2.pm +t/lib/Dev/Null.pm +t/lib/EmptyParser.pm +t/lib/IO/Capture.pm +t/lib/IO/c55Capture.pm +t/lib/MyCustom.pm +t/lib/MyFileSourceHandler.pm +t/lib/MyGrammar.pm +t/lib/MyIterator.pm +t/lib/MyIteratorFactory.pm +t/lib/MyPerlSource.pm +t/lib/MyPerlSourceHandler.pm +t/lib/MyResult.pm +t/lib/MyResultFactory.pm +t/lib/MySource.pm +t/lib/MySourceHandler.pm +t/lib/NOP.pm +t/lib/NoFork.pm +t/lib/TAP/Harness/TestSubclass.pm +t/lib/TAP/Parser/SubclassTest.pm +t/lib/Test/Builder.pm +t/lib/Test/Builder/Module.pm +t/lib/Test/More.pm +t/lib/Test/Simple.pm +t/lib/if.pm +t/multiplexer.t +t/nested.t +t/nofork-mux.t +t/nofork.t +t/object.t +t/parse.t +t/parser-config.t +t/parser-subclass.t +t/perl5lib.t +t/pod-coverage.t +t/pod.t +t/premature-bailout.t +t/process.t +t/prove.t +t/proveenv.t +t/proverc.t +t/proverc/emptyexec +t/proverun.t +t/proveversion.t +t/regression.t +t/results.t +t/sample-tests/bailout +t/sample-tests/bignum +t/sample-tests/bignum_many +t/sample-tests/combined +t/sample-tests/combined_compat +t/sample-tests/delayed +t/sample-tests/descriptive +t/sample-tests/descriptive_trailing +t/sample-tests/die +t/sample-tests/die_head_end +t/sample-tests/die_last_minute +t/sample-tests/die_unfinished +t/sample-tests/duplicates +t/sample-tests/echo +t/sample-tests/empty +t/sample-tests/escape_eol +t/sample-tests/escape_hash +t/sample-tests/head_end +t/sample-tests/head_fail +t/sample-tests/inc_taint +t/sample-tests/junk_before_plan +t/sample-tests/lone_not_bug +t/sample-tests/no_nums +t/sample-tests/no_output +t/sample-tests/out_err_mix +t/sample-tests/out_of_order +t/sample-tests/schwern +t/sample-tests/schwern-todo-quiet +t/sample-tests/segfault +t/sample-tests/sequence_misparse +t/sample-tests/shbang_misparse +t/sample-tests/simple +t/sample-tests/simple_fail +t/sample-tests/simple_yaml +t/sample-tests/simple_yaml_missing_version13 +t/sample-tests/skip +t/sample-tests/skip_nomsg +t/sample-tests/skipall +t/sample-tests/skipall_nomsg +t/sample-tests/skipall_v13 +t/sample-tests/space_after_plan +t/sample-tests/stdout_stderr +t/sample-tests/strict +t/sample-tests/switches +t/sample-tests/taint +t/sample-tests/taint_warn +t/sample-tests/todo +t/sample-tests/todo_inline +t/sample-tests/todo_misparse +t/sample-tests/too_many +t/sample-tests/version_good +t/sample-tests/version_late +t/sample-tests/version_old +t/sample-tests/vms_nit +t/sample-tests/with_comments +t/sample-tests/yaml_late_plan +t/sample-tests/zero_valid +t/scheduler.t +t/source.t +t/source_handler.t +t/source_tests/harness +t/source_tests/harness_badtap +t/source_tests/harness_complain +t/source_tests/harness_directives +t/source_tests/harness_failure +t/source_tests/psql +t/source_tests/psql.bat +t/source_tests/source +t/source_tests/source.1 +t/source_tests/source.bat +t/source_tests/source.pl +t/source_tests/source.sh +t/source_tests/source.t +t/source_tests/source.tap +t/source_tests/source_args.sh +t/source_tests/varsource +t/spool.t +t/state.t +t/state_results.t +t/streams.t +t/subclass_tests/non_perl_source +t/subclass_tests/perl_source +t/taint.t +t/testargs.t +t/unicode.t +t/utils.t +t/yamlish-output.t +t/yamlish-writer.t +t/yamlish.t +xt/author/pod-coverage.t +xt/author/pod.t +xt/author/stdin.t +xt/perls/harness_perl.t +xt/perls/sample-tests/perl_version diff --git a/META.json b/META.json new file mode 100644 index 0000000..a1ead81 --- /dev/null +++ b/META.json @@ -0,0 +1,58 @@ +{ + "abstract" : "unknown", + "author" : [ + "unknown" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", + "keywords" : [ + "TAP", + "test", + "harness", + "prove" + ], + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Test-Harness", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "recommends" : { + "Pod::Usage" : "1.12" + }, + "requires" : {} + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=Test-Harness" + }, + "homepage" : "http://testanything.org/", + "repository" : { + "url" : "http://github.com/Perl-Toolchain-Gang/Test-Harness/tree/master" + } + }, + "version" : "3.42", + "x_serialization_backend" : "JSON::PP version 2.27300" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..faac9f3 --- /dev/null +++ b/META.yml @@ -0,0 +1,33 @@ +--- +abstract: unknown +author: + - unknown +build_requires: + ExtUtils::MakeMaker: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' +keywords: + - TAP + - test + - harness + - prove +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Test-Harness +no_index: + directory: + - t + - inc +recommends: + Pod::Usage: '1.12' +requires: {} +resources: + bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Test-Harness + homepage: http://testanything.org/ + repository: http://github.com/Perl-Toolchain-Gang/Test-Harness/tree/master +version: '3.42' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..f0f54e9 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,81 @@ +#!perl + +require 5.006; + +# This Makefile.PL is provided for installation compatibility. +# Extra developer actions are in the Build.PL. + +use ExtUtils::MakeMaker qw/WriteMakefile prompt/; + +use strict; +use warnings; + +my %mm_args = ( + 'NAME' => 'Test::Harness', + 'VERSION_FROM' => 'lib/Test/Harness.pm', + 'INSTALLDIRS' => ($] < 5.011 ? 'perl' : 'site'), + 'PL_FILES' => {}, + 'test' => { 'TESTS' => 't/*.t t/compat/*.t' }, + + 'EXE_FILES' => ['bin/prove'], + 'PREREQ_PM' => {}, + 'META_MERGE' => { + resources => { + homepage => 'http://testanything.org/', + bugtracker => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Test-Harness', + +# MailingList => 'mailto:', + repository => 'http://github.com/Perl-Toolchain-Gang/Test-Harness/tree/master', + }, + keywords => [ 'TAP', 'test', 'harness', 'prove' ], + recommends => { + 'Pod::Usage' => '1.12', # for 'prove' + }, + }, +); + +{ + no warnings; + if ( $ExtUtils::MakeMaker::VERSION >= '6.31' ) { + $mm_args{LICENSE} = 'perl'; + } +} + +WriteMakefile(%mm_args); + +package MY; + +# Lifted from MM_Any.pm and modified so that make test tests against our +# own code rather than the incumbent. If we don't do this we end up +# loading a confused mixture of installed and new modules. +sub test_via_harness { + my ( $self, $perl, $tests ) = @_; + + return $self->SUPER::test_via_harness( + qq{$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)"}, $tests ); +} + +sub postamble { + return <<"END"; +testprove: pure_all + $^X -Iblib/lib bin/prove -b -r t + +testleaks: pure_all + $^X -MDevel::Leak::Object=GLOBAL_bless -Iblib/lib bin/prove -b -r t + +testreference: pure_all + $^X -Ireference/Test-Harness-2.64/lib reference/Test-Harness-2.64/bin/prove -Iblib/lib -r t + +testauthor: pure_all + $^X -Iblib/lib bin/prove -b -r xt + +critic: + perlcritic -1 -q -profile perlcriticrc bin/prove lib/ t/*.t + +tags: + ctags -f tags --recurse --totals --exclude=blib --exclude=.git --exclude='*~' --languages=Perl t/ lib/ bin/prove + +tidy: + (find lib t -name *.pm; find t -name *.t; echo Makefile.PL; echo bin/prove) | while read a; do perltidy -b \$\$a && rm \$\$a.bak; done; +END +} diff --git a/README b/README new file mode 100644 index 0000000..9868ca1 --- /dev/null +++ b/README @@ -0,0 +1,31 @@ +Test-Harness 3.24 + +INSTALLATION + +To install Test::Harness using ExtUtils::MakeMaker do: + + perl Makefile.PL + make + make test + make install + +To use Module::Build (preferred) do: + + perl NotBuild.PL + ./Build + ./Build test + ./Build install + +This will install Test::Harness and the "prove" program. Type + + prove --help + +for more information. + +COPYRIGHT AND LICENCE + +Copyright (C) 2006, 2007 Curtis "Ovid" Poe + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + diff --git a/bin/prove b/bin/prove new file mode 100755 index 0000000..3d41db0 --- /dev/null +++ b/bin/prove @@ -0,0 +1,407 @@ +#!/usr/bin/perl -w + +BEGIN { pop @INC if $INC[-1] eq '.' } +use strict; +use warnings; +use App::Prove; + +my $app = App::Prove->new; +$app->process_args(@ARGV); +exit( $app->run ? 0 : 1 ); + +__END__ + +=head1 NAME + +prove - Run tests through a TAP harness. + +=head1 USAGE + + prove [options] [files or directories] + +=head1 OPTIONS + +Boolean options: + + -v, --verbose Print all test lines. + -l, --lib Add 'lib' to the path for your tests (-Ilib). + -b, --blib Add 'blib/lib' and 'blib/arch' to the path for + your tests + -s, --shuffle Run the tests in random order. + -c, --color Colored test output (default). + --nocolor Do not color test output. + --count Show the X/Y test count when not verbose + (default) + --nocount Disable the X/Y test count. + -D --dry Dry run. Show test that would have run. + -f, --failures Show failed tests. + -o, --comments Show comments. + --ignore-exit Ignore exit status from test scripts. + -m, --merge Merge test scripts' STDERR with their STDOUT. + -r, --recurse Recursively descend into directories. + --reverse Run the tests in reverse order. + -q, --quiet Suppress some test output while running tests. + -Q, --QUIET Only print summary results. + -p, --parse Show full list of TAP parse errors, if any. + --directives Only show results with TODO or SKIP directives. + --timer Print elapsed time after each test. + --trap Trap Ctrl-C and print summary on interrupt. + --normalize Normalize TAP output in verbose output + -T Enable tainting checks. + -t Enable tainting warnings. + -W Enable fatal warnings. + -w Enable warnings. + -h, --help Display this help + -?, Display this help + -V, --version Display the version + -H, --man Longer manpage for prove + --norc Don't process default .proverc + +Options that take arguments: + + -I Library paths to include. + -P Load plugin (searches App::Prove::Plugin::*.) + -M Load a module. + -e, --exec Interpreter to run the tests ('' for compiled + tests.) + --ext Set the extension for tests (default '.t') + --harness Define test harness to use. See TAP::Harness. + --formatter Result formatter to use. See FORMATTERS. + --source Load and/or configure a SourceHandler. See + SOURCE HANDLERS. + -a, --archive out.tgz Store the resulting TAP in an archive file. + -j, --jobs N Run N test jobs in parallel (try 9.) + --state=opts Control prove's persistent state. + --statefile=file Use `file` instead of `.prove` for state + --rc=rcfile Process options from rcfile + --rules Rules for parallel vs sequential processing. + +=head1 NOTES + +=head2 .proverc + +If F<~/.proverc> or F<./.proverc> exist they will be read and any +options they contain processed before the command line options. Options +in F<.proverc> are specified in the same way as command line options: + + # .proverc + --state=hot,fast,save + -j9 + +Additional option files may be specified with the C<--rc> option. +Default option file processing is disabled by the C<--norc> option. + +Under Windows and VMS the option file is named F<_proverc> rather than +F<.proverc> and is sought only in the current directory. + +=head2 Reading from C + +If you have a list of tests (or URLs, or anything else you want to test) in a +file, you can add them to your tests by using a '-': + + prove - < my_list_of_things_to_test.txt + +See the C in the C directory of this distribution. + +=head2 Default Test Directory + +If no files or directories are supplied, C looks for all files +matching the pattern C. + +=head2 Colored Test Output + +Colored test output using L is the default, but +if output is not to a terminal, color is disabled. You can override this by +adding the C<--color> switch. + +Color support requires L and, on windows platforms, also +L. If the necessary module(s) are not installed +colored output will not be available. + +=head2 Exit Code + +If the tests fail C will exit with non-zero status. + +=head2 Arguments to Tests + +It is possible to supply arguments to tests. To do so separate them from +prove's own arguments with the arisdottle, '::'. For example + + prove -v t/mytest.t :: --url http://example.com + +would run F with the options '--url http://example.com'. +When running multiple tests they will each receive the same arguments. + +=head2 C<--exec> + +Normally you can just pass a list of Perl tests and the harness will know how +to execute them. However, if your tests are not written in Perl or if you +want all tests invoked exactly the same way, use the C<-e>, or C<--exec> +switch: + + prove --exec '/usr/bin/ruby -w' t/ + prove --exec '/usr/bin/perl -Tw -mstrict -Ilib' t/ + prove --exec '/path/to/my/customer/exec' + +=head2 C<--merge> + +If you need to make sure your diagnostics are displayed in the correct +order relative to test results you can use the C<--merge> option to +merge the test scripts' STDERR into their STDOUT. + +This guarantees that STDOUT (where the test results appear) and STDERR +(where the diagnostics appear) will stay in sync. The harness will +display any diagnostics your tests emit on STDERR. + +Caveat: this is a bit of a kludge. In particular note that if anything +that appears on STDERR looks like a test result the test harness will +get confused. Use this option only if you understand the consequences +and can live with the risk. + +=head2 C<--trap> + +The C<--trap> option will attempt to trap SIGINT (Ctrl-C) during a test +run and display the test summary even if the run is interrupted + +=head2 C<--state> + +You can ask C to remember the state of previous test runs and +select and/or order the tests to be run based on that saved state. + +The C<--state> switch requires an argument which must be a comma +separated list of one or more of the following options. + +=over + +=item C + +Run the same tests as the last time the state was saved. This makes it +possible, for example, to recreate the ordering of a shuffled test. + + # Run all tests in random order + $ prove -b --state=save --shuffle + + # Run them again in the same order + $ prove -b --state=last + +=item C + +Run only the tests that failed on the last run. + + # Run all tests + $ prove -b --state=save + + # Run failures + $ prove -b --state=failed + +If you also specify the C option newly passing tests will be +excluded from subsequent runs. + + # Repeat until no more failures + $ prove -b --state=failed,save + +=item C + +Run only the passed tests from last time. Useful to make sure that no +new problems have been introduced. + +=item C + +Run all tests in normal order. Multple options may be specified, so to +run all tests with the failures from last time first: + + $ prove -b --state=failed,all,save + +=item C + +Run the tests that most recently failed first. The last failure time of +each test is stored. The C option causes tests to be run in most-recent- +failure order. + + $ prove -b --state=hot,save + +Tests that have never failed will not be selected. To run all tests with +the most recently failed first use + + $ prove -b --state=hot,all,save + +This combination of options may also be specified thus + + $ prove -b --state=adrian + +=item C + +Run any tests with todos. + +=item C + +Run the tests in slowest to fastest order. This is useful in conjunction +with the C<-j> parallel testing switch to ensure that your slowest tests +start running first. + + $ prove -b --state=slow -j9 + +=item C + +Run test tests in fastest to slowest order. + +=item C + +Run the tests in newest to oldest order based on the modification times +of the test scripts. + +=item C + +Run the tests in oldest to newest order. + +=item C + +Run those test scripts that have been modified since the last test run. + +=item C + +Save the state on exit. The state is stored in a file called F<.prove> +(F<_prove> on Windows and VMS) in the current directory. + +=back + +The C<--state> switch may be used more than once. + + $ prove -b --state=hot --state=all,save + +=head2 --rules + +The C<--rules> option is used to control which tests are run sequentially and +which are run in parallel, if the C<--jobs> option is specified. The option may +be specified multiple times, and the order matters. + +The most practical use is likely to specify that some tests are not +"parallel-ready". Since mentioning a file with --rules doesn't cause it to +be selected to run as a test, you can "set and forget" some rules preferences in +your .proverc file. Then you'll be able to take maximum advantage of the +performance benefits of parallel testing, while some exceptions are still run +in parallel. + +=head3 --rules examples + + # All tests are allowed to run in parallel, except those starting with "p" + --rules='seq=t/p*.t' --rules='par=**' + + # All tests must run in sequence except those starting with "p", which should be run parallel + --rules='par=t/p*.t' + +=head3 --rules resolution + +=over 4 + +=item * By default, all tests are eligible to be run in parallel. Specifying any of your own rules removes this one. + +=item * "First match wins". The first rule that matches a test will be the one that applies. + +=item * Any test which does not match a rule will be run in sequence at the end of the run. + +=item * The existence of a rule does not imply selecting a test. You must still specify the tests to run. + +=item * Specifying a rule to allow tests to run in parallel does not make them run in parallel. You still need specify the number of parallel C in your Harness object. + +=back + +=head3 --rules Glob-style pattern matching + +We implement our own glob-style pattern matching for --rules. Here are the +supported patterns: + + ** is any number of characters, including /, within a pathname + * is zero or more characters within a filename/directory name + ? is exactly one character within a filename/directory name + {foo,bar,baz} is any of foo, bar or baz. + \ is an escape character + +=head3 More advanced specifications for parallel vs sequence run rules + +If you need more advanced management of what runs in parallel vs in sequence, see +the associated 'rules' documentation in L and L. +If what's possible directly through C is not sufficient, you can write your own +harness to access these features directly. + +=head2 @INC + +prove introduces a separation between "options passed to the perl which +runs prove" and "options passed to the perl which runs tests"; this +distinction is by design. Thus the perl which is running a test starts +with the default C<@INC>. Additional library directories can be added +via the C environment variable, via -Ifoo in C or +via the C<-Ilib> option to F. + +=head2 Taint Mode + +Normally when a Perl program is run in taint mode the contents of the +C environment variable do not appear in C<@INC>. + +Because C is often used during testing to add build +directories to C<@INC> prove passes the names of any directories found +in C as -I switches. The net effect of this is that +C is honoured even when prove is run in taint mode. + + +=head1 FORMATTERS + +You can load a custom L: + + prove --formatter MyFormatter + +=head1 SOURCE HANDLERS + +You can load custom Ls, to change the way the +parser interprets particular I of TAP. + + prove --source MyHandler --source YetAnother t + +If you want to provide config to the source you can use: + + prove --source MyCustom \ + --source Perl --perl-option 'foo=bar baz' --perl-option avg=0.278 \ + --source File --file-option extensions=.txt --file-option extensions=.tmp t + --source pgTAP --pgtap-option pset=format=html --pgtap-option pset=border=2 + +Each C<--$source-option> option must specify a key/value pair separated by an +C<=>. If an option can take multiple values, just specify it multiple times, +as with the C examples above. If the option should be a hash +reference, specify the value as a second pair separated by a C<=>, as in the +C examples above (escape C<=> with a backslash). + +All C<--sources> are combined into a hash, and passed to L's +C parameter. + +See L for more details on how configuration is +passed to I. + +=head1 PLUGINS + +Plugins can be loaded using the C<< -PI >> syntax, eg: + + prove -PMyPlugin + +This will search for a module named C, or failing +that, C. If the plugin can't be found, C will complain & exit. + +You can pass arguments to your plugin by appending C<=arg1,arg2,etc> to the +plugin name: + + prove -PMyPlugin=fou,du,fafa + +Please check individual plugin documentation for more details. + +=head2 Available Plugins + +For an up-to-date list of plugins available, please check CPAN: + +L + +=head2 Writing Plugins + +Please see L. + +=cut + +# vim:ts=4:sw=4:et:sta diff --git a/examples/README b/examples/README new file mode 100644 index 0000000..145a0f2 --- /dev/null +++ b/examples/README @@ -0,0 +1,54 @@ +=head1 EXAMPLES + +=head2 Running Tests in Multiple Languages + +If you have ruby installed in C, and also have +C installed, you can cd into C (the directory +where this README lives) and run the following command after installing the +C utility: + + examples $ runtests --exec ./my_exec t -v - < test_urls.txt + t/10-stuff..............Failed 1/6 tests + (less 2 skipped tests: 3 okay) + (1 test unexpectedly succeeded) + t/ruby..................ok + http://www.google.com/....ok + http://www.yahoo.com/.....ok + + Test Summary Report + ------------------- + t/10-stuff.t (Wstat: 256 Tests: 6 Failed: 1) + Failed tests: 2 + TODO passed: 6 + uests skipped: 3-4 + Files=4, Tests=10, 3 wallclock secs ( 0.92 cusr + 0.23 csys = 1.15 CPU) + +The C is a Perl program which tells the test harness how to execute +any tests it encounters. + +The C argument tells it to search in the C directory for any tests. +One of the tests it finds is written in Ruby, but the C program tells +it how to run this test. If you have Ruby installed but the test fails, try +changing the path. If you don't have Ruby installed, you can simply comment +out those lines in C, but the test will fail. + +The C<-> tells C to read from C and C is +merely a list of URLs we wish to test. + +See the documentation for C and C for more +information about how to use this. + +The C<-v> tells the harness to run in verbose mode. + +=head2 Custom Test Harnesses + +The C harnesses in the C directory are deprecated in +favor of the new C/C tools. They are left in primary +for curiosity sake, though you may find the C one useful as a +reference for how to create a GUI interface for C. + +Instead, simple override the desired methods in C to create +your own custom test harness. Don't like how the summary report is formatted? +Just override the C<&TAP::Harness::summary> method and use your new subclass: + + runtests --harness TAP::Harness::MyHarness diff --git a/examples/analyze_tests.pl b/examples/analyze_tests.pl new file mode 100644 index 0000000..c821f98 --- /dev/null +++ b/examples/analyze_tests.pl @@ -0,0 +1,86 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use lib 'lib'; +use App::Prove::State; +use List::Util 'sum'; +use Lingua::EN::Numbers 'num2en'; +use Text::Table; +use Carp; + +sub minutes_and_seconds { + my $seconds = shift; + return ( int( $seconds / 60 ), int( $seconds % 60 ) ); +} + +my $state = App::Prove::State->new( { store => '.prove' } ); +my $results = $state->results; +my $generation = $results->generation; +my @tests = $results->tests; + +my $total = sum( map { $_->elapsed } @tests ); +my ( $minutes, $seconds ) = minutes_and_seconds($total); + +my $num_tests = shift || 10; +my $total_tests = scalar $results->test_names; + +if ( $num_tests > $total_tests ) { + $num_tests = $total_tests; +} + +my $num_word = num2en($num_tests); + +my %time_for; +foreach my $test (@tests) { + $time_for{ $test->name } = $test->elapsed; +} + +my @sorted_by_time_desc + = sort { $time_for{$b} <=> $time_for{$a} } keys %time_for; + +print "Number of test programs: $total_tests\n"; +print "Total runtime approximately $minutes minutes $seconds seconds\n\n"; +print "\u$num_word slowest tests:\n"; + +my @rows; +for ( 0 .. $num_tests - 1 ) { + my $test = $sorted_by_time_desc[$_]; + my $time = $time_for{$test}; + my ( $minutes, $seconds ) = minutes_and_seconds($time); + push @rows => [ "${minutes}m ${seconds}s", $test, ]; +} + +print make_table( + [qw/Time Test/], + \@rows, +); + +sub make_table { + my ( $headers, $rows ) = @_; + + my @rule = qw(- +); + my @headers = \'| '; + push @headers => map { $_ => \' | ' } @$headers; + pop @headers; + push @headers => \' |'; + + unless ( 'ARRAY' eq ref $rows + && 'ARRAY' eq ref $rows->[0] + && @$headers == @{ $rows->[0] } ) + { + croak( + "make_table() rows must be an AoA with rows being same size as headers" + ); + } + my $table = Text::Table->new(@headers); + $table->rule(@rule); + $table->body_rule(@rule); + $table->load(@$rows); + return $table->rule(@rule), + $table->title, + $table->rule(@rule), + map( { $table->body($_) } 0 .. @$rows ), + $table->rule(@rule); +} diff --git a/examples/bin/forked_tests.pl b/examples/bin/forked_tests.pl new file mode 100644 index 0000000..720003c --- /dev/null +++ b/examples/bin/forked_tests.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +# Run tests in parallel. This just allows you to check that your tests +# are roughly capable of running in parallel. It writes output to a +# tree in /tmp. +# From: Eric Wilhelm @ ewilhelm at cpan.org + +use warnings; +use strict; + +use File::Basename (); +use File::Path (); +use List::Util (); + +my @tests = @ARGV; + +#@tests = List::Util::shuffle(@tests); + +use POSIX (); + +my %map; +my $i = 0; + +my $jobs = 9; # scalar(@tests); # if you like forkbombs +my @running; + +while (@tests) { + if ( $jobs == @running ) { + my @list; + while ( my $pid = shift(@running) ) { + if ( waitpid( $pid, POSIX::WNOHANG() ) > 0 ) { + warn ' ' x 25 . "done $map{$pid}\n"; + next; + } + push( @list, $pid ); + } + + #warn "running ", scalar(@list); + @running = @list; + next; + } + my $test = shift(@tests); + defined( my $pid = fork ) or die; + $i++; + if ($pid) { + push( @running, $pid ); + $map{$pid} = $test; + print "$test\n"; + } + else { + my $dest_base = '/tmp'; + my $dest_dir = File::Basename::dirname("$dest_base/$test"); + unless ( -d $dest_dir ) { + File::Path::mkpath($dest_dir) or die; + } + + $| = 1; + open( STDOUT, '>', "$dest_base/$test.out" ) or die; + open( STDERR, '>', "$dest_base/$test.err" ) or die; + exec( $^X, '-Ilib', $test ); + } +} + +my $v = 0; +until ( $v == -1 ) { + $v = wait; + ( $v == -1 ) and last; + $? and warn "$map{$v} ($v) no happy $?"; +} +print "bye\n"; + +# vim:ts=2:sw=2:et:sta diff --git a/examples/bin/test_html.pl b/examples/bin/test_html.pl new file mode 100755 index 0000000..dcb2f59 --- /dev/null +++ b/examples/bin/test_html.pl @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 1; +use Test::WWW::Mechanize; + +my $mech = Test::WWW::Mechanize->new; +my $url = shift; +$mech->get_ok( + $url, + "We should be able to fetch ($url)" +); diff --git a/examples/bin/tprove_gtk b/examples/bin/tprove_gtk new file mode 100644 index 0000000..773b293 --- /dev/null +++ b/examples/bin/tprove_gtk @@ -0,0 +1,469 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use File::Find; +use IO::Handle; + +die "Unsupported"; + +############################################################################## + +=head1 NAME + +tprove_gtk - Simple proof of concept GUI for proving tests + +=head1 USAGE + + tprove_gtk [ list of test files ] + +=head1 DESCRIPTION + +I've included this in the distribution. It's a gtk interface by Torsten +Schoenfeld. I've not run it myself. + +C is not installed on your system unless you explicitly copy it +somewhere in your path. The current incarnation B be run in a directory +with both C and C (i.e., the standard "root" level directory in +which CPAN style modules are developed). This will probably change in the +future. As noted, this is a proof of concept. + +=head1 CAVEATS + +This is alpha code. You've been warned. + +=cut + +my @tests; +if (@ARGV) { + @tests = @ARGV; +} +else { + find( + sub { -f && /\.t$/ && push @tests => $File::Find::name }, + "t" + ); +} + +pipe( my $reader, my $writer ); + +# Unfortunately, autoflush-ing seems to be a big performance problem. If you +# don't care about "real-time" progress bars, turn this off. +$writer->autoflush(1); + +if ( my $pid = fork ) { + close $writer; + + my $gui = Gui->new( $pid, $reader ); + $gui->add_tests(@tests); + $gui->run(); +} + +else { + die "Cannot fork: $!" unless defined $pid; + close $reader; + + my $runner = TestRunner->new($writer); + $runner->add_tests(@tests); + $runner->run(); + + close $writer; +} + +############################################################################### +# --------------------------------------------------------------------------- # +############################################################################### + +package Gui; + +use Glib qw(TRUE FALSE); +use Gtk2 -init; + +use constant { + COLUMN_FILENAME => 0, + COLUMN_TOTAL => 1, + COLUMN_RUN => 2, + COLUMN_PASS => 3, + COLUMN_FAIL => 4, + COLUMN_SKIP => 5, + COLUMN_TODO => 6, +}; + +BEGIN { + if ( !Gtk2->CHECK_VERSION( 2, 6, 0 ) ) { + die("$0 needs gtk+ >= 2.6"); + } +} + +DESTROY { + my ($self) = @_; + + if ( defined $self->{reader_source} ) { + Glib::Source->remove( $self->{reader_source} ); + } +} + +sub new { + my ( $class, $child_pid, $reader ) = @_; + + my $self = bless {}, $class; + + $self->create_window(); + $self->create_menu(); + $self->create_view(); + + $self->{child_pid} = $child_pid; + $self->{child_running} = TRUE; + + $self->{reader_source} = Glib::IO->add_watch( + fileno $reader, [qw(in pri hup)], + \&_callback_reader, $self + ); + + return $self; +} + +sub add_tests { + my ( $self, @tests ) = @_; + + my $model = $self->{_model}; + + $self->{_path_cache} = {}; + + foreach my $test (@tests) { + my $iter = $model->append(); + $model->set( $iter, COLUMN_FILENAME, $test ); + $self->{_path_cache}->{$test} = $model->get_path($iter); + } +} + +sub create_window { + my ($self) = @_; + + my $window = Gtk2::Window->new(); + my $vbox = Gtk2::VBox->new( FALSE, 5 ); + + $window->add($vbox); + $window->set_title("Test Runner"); + $window->set_default_size( 300, 600 ); + $window->signal_connect( delete_event => \&_callback_quit, $self ); + + $self->{_window} = $window; + $self->{_vbox} = $vbox; +} + +sub create_menu { + my ($self) = @_; + + my $window = $self->{_window}; + my $vbox = $self->{_vbox}; + + my $ui = <<"UI"; + + + + + + + +UI + + my $actions = [ + [ "test_menu", undef, "_Tests" ], + [ "quit_item", + "gtk-quit", + "_Quit", + "Q", + "Quit the test runner", + sub { _callback_quit( undef, undef, $self ) }, + ], + ]; + + my $action_group = Gtk2::ActionGroup->new("main"); + $action_group->add_actions($actions); + + my $manager = Gtk2::UIManager->new(); + $manager->insert_action_group( $action_group, 0 ); + $manager->add_ui_from_string($ui); + + my $menu_box = Gtk2::VBox->new( FALSE, 0 ); + $manager->signal_connect( + add_widget => sub { + my ( $manager, $widget ) = @_; + $menu_box->pack_start( $widget, FALSE, FALSE, 0 ); + } + ); + + $vbox->pack_start( $menu_box, FALSE, FALSE, 0 ); + $window->add_accel_group( $manager->get_accel_group() ); + + $self->{_manager} = $manager; +} + +sub create_view { + my ($self) = @_; + + my $window = $self->{_window}; + my $vbox = $self->{_vbox}; + + my $scroller = Gtk2::ScrolledWindow->new(); + $scroller->set_policy( "never", "automatic" ); + + my $model = Gtk2::ListStore->new( + + # filename total run pass fail skip todo + qw(Glib::String Glib::Int Glib::Int Glib::Int Glib::Int Glib::Int Glib::Int) + ); + my $view = Gtk2::TreeView->new($model); + + # ------------------------------------------------------------------------- # + + my $column_filename = Gtk2::TreeViewColumn->new_with_attributes( + "Filename", + Gtk2::CellRendererText->new(), + text => COLUMN_FILENAME + ); + $column_filename->set_sizing("autosize"); + $column_filename->set_expand(TRUE); + $view->append_column($column_filename); + + # ------------------------------------------------------------------------- # + + my $renderer_progress = Gtk2::CellRendererProgress->new(); + my $column_progress = Gtk2::TreeViewColumn->new_with_attributes( + "Progress", + $renderer_progress + ); + $column_progress->set_cell_data_func( + $renderer_progress, + sub { + my ( $column, $renderer, $model, $iter ) = @_; + + my ( $total, $run ) + = $model->get( $iter, COLUMN_TOTAL, COLUMN_RUN ); + + if ( $run == 0 ) { + $renderer->set( + text => "", + value => 0 + ); + return; + } + + if ( $total != 0 ) { + $renderer->set( + text => "$run/$total", + value => $run / $total * 100 + ); + } + else { + $renderer->set( + text => $run, + value => 0 + ); + } + } + ); + $view->append_column($column_progress); + + # ------------------------------------------------------------------------- # + + my @count_columns = ( + [ "Pass", COLUMN_PASS ], + [ "Fail", COLUMN_FAIL ], + [ "Skip", COLUMN_SKIP ], + [ "Todo", COLUMN_TODO ], + ); + + foreach (@count_columns) { + my ( $heading, $column_number ) = @{$_}; + + my $renderer = Gtk2::CellRendererText->new(); + $renderer->set( xalign => 1.0 ); + + my $column = Gtk2::TreeViewColumn->new_with_attributes( + $heading, + $renderer, + text => $column_number + ); + + $view->append_column($column); + } + + # ------------------------------------------------------------------------- # + + $scroller->add($view); + $vbox->pack_start( $scroller, TRUE, TRUE, 0 ); + + $self->{_view} = $view; + $self->{_model} = $model; +} + +sub run { + my ($self) = @_; + + $self->{_window}->show_all(); + + Gtk2->main(); +} + +# --------------------------------------------------------------------------- # + +sub _callback_reader { + my ( $fileno, $condition, $self ) = @_; + + if ( $condition & "in" || $condition & "pri" ) { + my $data = <$reader>; + + if ( $data !~ /^[^\t]+ \t \d+ \t \d+ \t \d+ \t \d+ \t \d+ \t \d+$/x ) + { + return TRUE; + } + + my ( $filename, $total, $run, $pass, $fail, $skip, $todo ) + = split /\t/, $data; + + my $view = $self->{_view}; + my $model = $self->{_model}; + my $path_cache = $self->{_path_cache}; + + if ( $path_cache->{$filename} ) { + my $iter = $model->get_iter( $path_cache->{$filename} ); + $model->set( + $iter, + COLUMN_TOTAL, $total, + COLUMN_RUN, $run, + COLUMN_PASS, $pass, + COLUMN_FAIL, $fail, + COLUMN_SKIP, $skip, + COLUMN_TODO, $todo + ); + $view->scroll_to_cell( $path_cache->{$filename} ); + } + } + + elsif ( $condition & "hup" ) { + $self->{child_running} = FALSE; + return FALSE; + } + + else { + warn "got unknown condition: $condition"; + return FALSE; + } + + return TRUE; +} + +sub _callback_quit { + my ( $window, $event, $self ) = @_; + + if ( $self->{child_running} ) { + kill "TERM", $self->{child_pid}; + } + + Gtk2->main_quit(); +} + +############################################################################### +# --------------------------------------------------------------------------- # +############################################################################### + +package TestRunner; + +use TAP::Parser; +use TAP::Parser::Source::Perl; + +use constant { + INDEX_TOTAL => 0, + INDEX_RUN => 1, + INDEX_PASS => 2, + INDEX_FAIL => 3, + INDEX_SKIP => 4, + INDEX_TODO => 5, +}; + +sub new { + my ( $class, $writer ) = @_; + + my $self = bless {}, $class; + + $self->{_writer} = $writer; + + return $self; +} + +sub add_tests { + my ( $self, @tests ) = @_; + + $self->{_tests} = [@tests]; + + $self->{_results} = {}; + foreach my $test ( @{ $self->{_tests} } ) { + $self->{_results}->{$test} = [ 0, 0, 0, 0, 0, 0 ]; + } +} + +sub run { + my ($self) = @_; + + my $source = TAP::Parser::Source::Perl->new(); + + foreach my $test ( @{ $self->{_tests} } ) { + my $parser = TAP::Parser->new( { source => $test } ); + $self->analyze( $test, $parser ) if $parser; + } + + my $writer = $self->{_writer}; + $writer->flush(); + $writer->print("\n"); +} + +sub analyze { + my ( $self, $test, $parser ) = @_; + + my $writer = $self->{_writer}; + my $result = $self->{_results}->{$test}; + + while ( my $line = $parser->next() ) { + if ( $line->is_plan() ) { + $result->[INDEX_TOTAL] = $line->tests_planned(); + } + + elsif ( $line->is_test() ) { + $result->[INDEX_RUN]++; + + if ( $line->has_skip() ) { + $result->[INDEX_SKIP]++; + next; + } + + if ( $line->has_todo() ) { + $result->[INDEX_TODO]++; + } + + if ( $line->is_ok() ) { + $result->[INDEX_PASS]++; + } + else { + $result->[INDEX_FAIL]++; + } + } + + elsif ( $line->is_comment() ) { + + # ignore + } + + else { + warn "Unknown result type `" + . $line->type() . "�: " + . $line->as_string(); + } + + my $string = join "\t", $test, @{$result}; + $writer->print("$string\n"); + } + + return $parser; +} diff --git a/examples/harness-hook/hook.pl b/examples/harness-hook/hook.pl new file mode 100755 index 0000000..8cfc628 --- /dev/null +++ b/examples/harness-hook/hook.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use lib qw( lib ../../lib ); +use Harness::Hook; +use TAP::Harness; +use File::Spec; + +$| = 1; + +my $harness = TAP::Harness->new; + +# Install the hook +Harness::Hook->new($harness); + +$harness->runtests( + File::Spec->catfile( split( /\//, '../../t/000-load.t' ) ) ); diff --git a/examples/harness-hook/lib/Harness/Hook.pm b/examples/harness-hook/lib/Harness/Hook.pm new file mode 100644 index 0000000..1f8f63f --- /dev/null +++ b/examples/harness-hook/lib/Harness/Hook.pm @@ -0,0 +1,30 @@ +package Harness::Hook; + +use strict; +use warnings; +use Carp; + +sub new { + my ( $class, $harness ) = @_; + my $self = bless {}, $class; + + $harness->callback( + 'before_runtests', + sub { + my ($aggregate) = @_; + warn "Before runtests\n"; + } + ); + + $harness->callback( + 'after_runtests', + sub { + my ( $aggregate, $results ) = @_; + warn "After runtests\n"; + } + ); + + return $self; +} + +1; diff --git a/examples/my_exec b/examples/my_exec new file mode 100755 index 0000000..ea66985 --- /dev/null +++ b/examples/my_exec @@ -0,0 +1,22 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +my $url = qr/^http/; +my $prog = shift; +if ( $prog !~ $url && !-e $prog ) { + die "Cannot find ($prog)"; +} +my @exec; + +if ( 't/ruby.t' eq $prog ) { + push @exec => '/usr/bin/ruby', $prog; +} +elsif ( $prog =~ $url ) { + push @exec => 'bin/test_html.pl', $prog; +} +else { + push @exec, $prog; +} +exec @exec or die "Cannot (exec @exec): $!"; diff --git a/examples/silent-harness.pl b/examples/silent-harness.pl new file mode 100644 index 0000000..ae0e50e --- /dev/null +++ b/examples/silent-harness.pl @@ -0,0 +1,16 @@ +#!/usr/bin/perl +# +# Run some tests and get back a data structure describing them. + +use strict; +use warnings; +use TAP::Harness; +use Data::Dumper; + +my @tests = glob 't/yaml*.t'; + +my $harness = TAP::Harness->new( { verbosity => -9, lib => ['blib/lib'] } ); + +# $aggregate is a TAP::Parser::Aggregator +my $aggregate = $harness->runtests(@tests); +print Dumper($aggregate); diff --git a/examples/t/10-stuff.t b/examples/t/10-stuff.t new file mode 100644 index 0000000..3e774d0 --- /dev/null +++ b/examples/t/10-stuff.t @@ -0,0 +1,18 @@ +#!/usr/bin/perl -wT +use strict; +use warnings; + +use Test::More qw/no_plan/; + +ok 1, 'this test passes'; +is_deeply [2], [3], 'this is_deeply test fails'; +SKIP: { + skip 'testing skip', 2 if 1; + ok 1; + ok 1; +} +TODO: { + local $TODO = 'this is a TODO test'; + ok 0, 'This should succeed'; + ok 1, 'This should fail'; +} diff --git a/examples/t/ruby.t b/examples/t/ruby.t new file mode 100644 index 0000000..589afdd --- /dev/null +++ b/examples/t/ruby.t @@ -0,0 +1,3 @@ +puts("1..2"); +puts("ok 1"); +puts("ok 2"); diff --git a/examples/test_urls.txt b/examples/test_urls.txt new file mode 100644 index 0000000..7454eec --- /dev/null +++ b/examples/test_urls.txt @@ -0,0 +1,2 @@ +http://www.google.com/ +http://www.yahoo.com/ diff --git a/lib/App/Prove.pm b/lib/App/Prove.pm new file mode 100644 index 0000000..9298726 --- /dev/null +++ b/lib/App/Prove.pm @@ -0,0 +1,829 @@ +package App::Prove; + +use strict; +use warnings; + +use TAP::Harness::Env; +use Text::ParseWords qw(shellwords); +use File::Spec; +use Getopt::Long; +use App::Prove::State; +use Carp; + +use base 'TAP::Object'; + +=head1 NAME + +App::Prove - Implements the C command. + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +L provides a command, C, which runs a TAP based +test suite and prints a report. The C command is a minimal +wrapper around an instance of this module. + +=head1 SYNOPSIS + + use App::Prove; + + my $app = App::Prove->new; + $app->process_args(@ARGV); + $app->run; + +=cut + +use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); +use constant IS_VMS => $^O eq 'VMS'; +use constant IS_UNIXY => !( IS_VMS || IS_WIN32 ); + +use constant STATE_FILE => IS_UNIXY ? '.prove' : '_prove'; +use constant RC_FILE => IS_UNIXY ? '.proverc' : '_proverc'; + +use constant PLUGINS => 'App::Prove::Plugin'; + +my @ATTR; + +BEGIN { + @ATTR = qw( + archive argv blib show_count color directives exec failures comments + formatter harness includes modules plugins jobs lib merge parse quiet + really_quiet recurse backwards shuffle taint_fail taint_warn timer + verbose warnings_fail warnings_warn show_help show_man show_version + state_class test_args state dry extensions ignore_exit rules state_manager + normalize sources tapversion trap + statefile + ); + __PACKAGE__->mk_methods(@ATTR); +} + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +Create a new C. Optionally a hash ref of attribute +initializers may be passed. + +=cut + +# new() implementation supplied by TAP::Object + +sub _initialize { + my $self = shift; + my $args = shift || {}; + + my @is_array = qw( + argv rc_opts includes modules state plugins rules sources + ); + + # setup defaults: + for my $key (@is_array) { + $self->{$key} = []; + } + + for my $attr (@ATTR) { + if ( exists $args->{$attr} ) { + + # TODO: Some validation here + $self->{$attr} = $args->{$attr}; + } + } + + $self->state_class('App::Prove::State'); + return $self; +} + +=head3 C + +Getter/setter for the name of the class used for maintaining state. This +class should either subclass from C or provide an identical +interface. + +=head3 C + +Getter/setter for the instance of the C. + +=cut + +=head3 C + + $prove->add_rc_file('myproj/.proverc'); + +Called before C to prepend the contents of an rc file to +the options. + +=cut + +sub add_rc_file { + my ( $self, $rc_file ) = @_; + + local *RC; + open RC, "<$rc_file" or croak "Can't read $rc_file ($!)"; + while ( defined( my $line = ) ) { + push @{ $self->{rc_opts} }, + grep { defined and not /^#/ } + $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S+) }xg; + } + close RC; +} + +=head3 C + + $prove->process_args(@args); + +Processes the command-line arguments. Attributes will be set +appropriately. Any filenames may be found in the C attribute. + +Dies on invalid arguments. + +=cut + +sub process_args { + my $self = shift; + + my @rc = RC_FILE; + unshift @rc, glob '~/' . RC_FILE if IS_UNIXY; + + # Preprocess meta-args. + my @args; + while ( defined( my $arg = shift ) ) { + if ( $arg eq '--norc' ) { + @rc = (); + } + elsif ( $arg eq '--rc' ) { + defined( my $rc = shift ) + or croak "Missing argument to --rc"; + push @rc, $rc; + } + elsif ( $arg =~ m{^--rc=(.+)$} ) { + push @rc, $1; + } + else { + push @args, $arg; + } + } + + # Everything after the arisdottle '::' gets passed as args to + # test programs. + if ( defined( my $stop_at = _first_pos( '::', @args ) ) ) { + my @test_args = splice @args, $stop_at; + shift @test_args; + $self->{test_args} = \@test_args; + } + + # Grab options from RC files + $self->add_rc_file($_) for grep -f, @rc; + unshift @args, @{ $self->{rc_opts} }; + + if ( my @bad = map {"-$_"} grep {/^-(man|help)$/} @args ) { + die "Long options should be written with two dashes: ", + join( ', ', @bad ), "\n"; + } + + # And finally... + + { + local @ARGV = @args; + Getopt::Long::Configure(qw(no_ignore_case bundling pass_through)); + + # Don't add coderefs to GetOptions + GetOptions( + 'v|verbose' => \$self->{verbose}, + 'f|failures' => \$self->{failures}, + 'o|comments' => \$self->{comments}, + 'l|lib' => \$self->{lib}, + 'b|blib' => \$self->{blib}, + 's|shuffle' => \$self->{shuffle}, + 'color!' => \$self->{color}, + 'colour!' => \$self->{color}, + 'count!' => \$self->{show_count}, + 'c' => \$self->{color}, + 'D|dry' => \$self->{dry}, + 'ext=s@' => sub { + my ( $opt, $val ) = @_; + + # Workaround for Getopt::Long 2.25 handling of + # multivalue options + push @{ $self->{extensions} ||= [] }, $val; + }, + 'harness=s' => \$self->{harness}, + 'ignore-exit' => \$self->{ignore_exit}, + 'source=s@' => $self->{sources}, + 'formatter=s' => \$self->{formatter}, + 'r|recurse' => \$self->{recurse}, + 'reverse' => \$self->{backwards}, + 'p|parse' => \$self->{parse}, + 'q|quiet' => \$self->{quiet}, + 'Q|QUIET' => \$self->{really_quiet}, + 'e|exec=s' => \$self->{exec}, + 'm|merge' => \$self->{merge}, + 'I=s@' => $self->{includes}, + 'M=s@' => $self->{modules}, + 'P=s@' => $self->{plugins}, + 'state=s@' => $self->{state}, + 'statefile=s' => \$self->{statefile}, + 'directives' => \$self->{directives}, + 'h|help|?' => \$self->{show_help}, + 'H|man' => \$self->{show_man}, + 'V|version' => \$self->{show_version}, + 'a|archive=s' => \$self->{archive}, + 'j|jobs=i' => \$self->{jobs}, + 'timer' => \$self->{timer}, + 'T' => \$self->{taint_fail}, + 't' => \$self->{taint_warn}, + 'W' => \$self->{warnings_fail}, + 'w' => \$self->{warnings_warn}, + 'normalize' => \$self->{normalize}, + 'rules=s@' => $self->{rules}, + 'tapversion=s' => \$self->{tapversion}, + 'trap' => \$self->{trap}, + ) or croak('Unable to continue'); + + # Stash the remainder of argv for later + $self->{argv} = [@ARGV]; + } + + return; +} + +sub _first_pos { + my $want = shift; + for ( 0 .. $#_ ) { + return $_ if $_[$_] eq $want; + } + return; +} + +sub _help { + my ( $self, $verbosity ) = @_; + + eval('use Pod::Usage 1.12 ()'); + if ( my $err = $@ ) { + die 'Please install Pod::Usage for the --help option ' + . '(or try `perldoc prove`.)' + . "\n ($@)"; + } + + Pod::Usage::pod2usage( { -verbose => $verbosity } ); + + return; +} + +sub _color_default { + my $self = shift; + + return -t STDOUT && !$ENV{HARNESS_NOTTY}; +} + +sub _get_args { + my $self = shift; + + my %args; + + $args{trap} = 1 if $self->trap; + + if ( defined $self->color ? $self->color : $self->_color_default ) { + $args{color} = 1; + } + if ( !defined $self->show_count ) { + $args{show_count} = 1; + } + else { + $args{show_count} = $self->show_count; + } + + if ( $self->archive ) { + $self->require_harness( archive => 'TAP::Harness::Archive' ); + $args{archive} = $self->archive; + } + + if ( my $jobs = $self->jobs ) { + $args{jobs} = $jobs; + } + + if ( my $harness_opt = $self->harness ) { + $self->require_harness( harness => $harness_opt ); + } + + if ( my $formatter = $self->formatter ) { + $args{formatter_class} = $formatter; + } + + for my $handler ( @{ $self->sources } ) { + my ( $name, $config ) = $self->_parse_source($handler); + $args{sources}->{$name} = $config; + } + + if ( $self->ignore_exit ) { + $args{ignore_exit} = 1; + } + + if ( $self->taint_fail && $self->taint_warn ) { + die '-t and -T are mutually exclusive'; + } + + if ( $self->warnings_fail && $self->warnings_warn ) { + die '-w and -W are mutually exclusive'; + } + + for my $a (qw( lib switches )) { + my $method = "_get_$a"; + my $val = $self->$method(); + $args{$a} = $val if defined $val; + } + + # Handle verbose, quiet, really_quiet flags + my %verb_map = ( verbose => 1, quiet => -1, really_quiet => -2, ); + + my @verb_adj = grep {$_} map { $self->$_() ? $verb_map{$_} : 0 } + keys %verb_map; + + die "Only one of verbose, quiet or really_quiet should be specified\n" + if @verb_adj > 1; + + $args{verbosity} = shift @verb_adj || 0; + + for my $a (qw( merge failures comments timer directives normalize )) { + $args{$a} = 1 if $self->$a(); + } + + $args{errors} = 1 if $self->parse; + + # defined but zero-length exec runs test files as binaries + $args{exec} = [ split( /\s+/, $self->exec ) ] + if ( defined( $self->exec ) ); + + $args{version} = $self->tapversion if defined( $self->tapversion ); + + if ( defined( my $test_args = $self->test_args ) ) { + $args{test_args} = $test_args; + } + + if ( @{ $self->rules } ) { + my @rules; + for ( @{ $self->rules } ) { + if (/^par=(.*)/) { + push @rules, $1; + } + elsif (/^seq=(.*)/) { + push @rules, { seq => $1 }; + } + } + $args{rules} = { par => [@rules] }; + } + $args{harness_class} = $self->{harness_class} if $self->{harness_class}; + + return \%args; +} + +sub _find_module { + my ( $self, $class, @search ) = @_; + + croak "Bad module name $class" + unless $class =~ /^ \w+ (?: :: \w+ ) *$/x; + + for my $pfx (@search) { + my $name = join( '::', $pfx, $class ); + eval "require $name"; + return $name unless $@; + } + + eval "require $class"; + return $class unless $@; + return; +} + +sub _load_extension { + my ( $self, $name, @search ) = @_; + + my @args = (); + if ( $name =~ /^(.*?)=(.*)/ ) { + $name = $1; + @args = split( /,/, $2 ); + } + + if ( my $class = $self->_find_module( $name, @search ) ) { + $class->import(@args); + if ( $class->can('load') ) { + $class->load( { app_prove => $self, args => [@args] } ); + } + } + else { + croak "Can't load module $name"; + } +} + +sub _load_extensions { + my ( $self, $ext, @search ) = @_; + $self->_load_extension( $_, @search ) for @$ext; +} + +sub _parse_source { + my ( $self, $handler ) = @_; + + # Load any options. + ( my $opt_name = lc $handler ) =~ s/::/-/g; + local @ARGV = @{ $self->{argv} }; + my %config; + Getopt::Long::GetOptions( + "$opt_name-option=s%" => sub { + my ( $name, $k, $v ) = @_; + if ( $v =~ /(? $v; + } + else { + $config{$k} = $v; + } + } + } + ); + $self->{argv} = \@ARGV; + return ( $handler, \%config ); +} + +=head3 C + +Perform whatever actions the command line args specified. The C +command line tool consists of the following code: + + use App::Prove; + + my $app = App::Prove->new; + $app->process_args(@ARGV); + exit( $app->run ? 0 : 1 ); # if you need the exit code + +=cut + +sub run { + my $self = shift; + + unless ( $self->state_manager ) { + $self->state_manager( + $self->state_class->new( { store => $self->statefile || STATE_FILE } ) ); + } + + if ( $self->show_help ) { + $self->_help(1); + } + elsif ( $self->show_man ) { + $self->_help(2); + } + elsif ( $self->show_version ) { + $self->print_version; + } + elsif ( $self->dry ) { + print "$_\n" for $self->_get_tests; + } + else { + + $self->_load_extensions( $self->modules ); + $self->_load_extensions( $self->plugins, PLUGINS ); + + local $ENV{TEST_VERBOSE} = 1 if $self->verbose; + + return $self->_runtests( $self->_get_args, $self->_get_tests ); + } + + return 1; +} + +sub _get_tests { + my $self = shift; + + my $state = $self->state_manager; + my $ext = $self->extensions; + $state->extensions($ext) if defined $ext; + if ( defined( my $state_switch = $self->state ) ) { + $state->apply_switch(@$state_switch); + } + + my @tests = $state->get_tests( $self->recurse, @{ $self->argv } ); + + $self->_shuffle(@tests) if $self->shuffle; + @tests = reverse @tests if $self->backwards; + + return @tests; +} + +sub _runtests { + my ( $self, $args, @tests ) = @_; + my $harness = TAP::Harness::Env->create($args); + + my $state = $self->state_manager; + + $harness->callback( + after_test => sub { + $state->observe_test(@_); + } + ); + + $harness->callback( + after_runtests => sub { + $state->commit(@_); + } + ); + + my $aggregator = $harness->runtests(@tests); + + return !$aggregator->has_errors; +} + +sub _get_switches { + my $self = shift; + my @switches; + + # notes that -T or -t must be at the front of the switches! + if ( $self->taint_fail ) { + push @switches, '-T'; + } + elsif ( $self->taint_warn ) { + push @switches, '-t'; + } + if ( $self->warnings_fail ) { + push @switches, '-W'; + } + elsif ( $self->warnings_warn ) { + push @switches, '-w'; + } + + return @switches ? \@switches : (); +} + +sub _get_lib { + my $self = shift; + my @libs; + if ( $self->lib ) { + push @libs, 'lib'; + } + if ( $self->blib ) { + push @libs, 'blib/lib', 'blib/arch'; + } + if ( @{ $self->includes } ) { + push @libs, @{ $self->includes }; + } + + #24926 + @libs = map { File::Spec->rel2abs($_) } @libs; + + # Huh? + return @libs ? \@libs : (); +} + +sub _shuffle { + my $self = shift; + + # Fisher-Yates shuffle + my $i = @_; + while ($i) { + my $j = rand $i--; + @_[ $i, $j ] = @_[ $j, $i ]; + } + return; +} + +=head3 C + +Load a harness replacement class. + + $prove->require_harness($for => $class_name); + +=cut + +sub require_harness { + my ( $self, $for, $class ) = @_; + + my ($class_name) = $class =~ /^(\w+(?:::\w+)*)/; + + # Emulate Perl's -MModule=arg1,arg2 behaviour + $class =~ s!^(\w+(?:::\w+)*)=(.*)$!$1 split(/,/,q{$2})!; + + eval("use $class;"); + die "$class_name is required to use the --$for feature: $@" if $@; + + $self->{harness_class} = $class_name; + + return; +} + +=head3 C + +Display the version numbers of the loaded L and the +current Perl. + +=cut + +sub print_version { + my $self = shift; + require TAP::Harness; + printf( + "TAP::Harness v%s and Perl v%vd\n", + $TAP::Harness::VERSION, $^V + ); + + return; +} + +1; + +# vim:ts=4:sw=4:et:sta + +__END__ + +=head2 Attributes + +After command line parsing the following attributes reflect the values +of the corresponding command line switches. They may be altered before +calling C. + +=over + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=back + +=head1 PLUGINS + +C provides support for 3rd-party plugins. These are currently +loaded at run-time, I arguments have been parsed (so you can not +change the way arguments are processed, sorry), typically with the +C<< -PI >> switch, eg: + + prove -PMyPlugin + +This will search for a module named C, or failing +that, C. If the plugin can't be found, C will complain & exit. + +You can pass an argument to your plugin by appending an C<=> after the plugin +name, eg C<-PMyPlugin=foo>. You can pass multiple arguments using commas: + + prove -PMyPlugin=foo,bar,baz + +These are passed in to your plugin's C class method (if it has one), +along with a reference to the C object that is invoking your plugin: + + sub load { + my ($class, $p) = @_; + + my @args = @{ $p->{args} }; + # @args will contain ( 'foo', 'bar', 'baz' ) + $p->{app_prove}->do_something; + ... + } + +Note that the user's arguments are also passed to your plugin's C +function as a list, eg: + + sub import { + my ($class, @args) = @_; + # @args will contain ( 'foo', 'bar', 'baz' ) + ... + } + +This is for backwards compatibility, and may be deprecated in the future. + +=head2 Sample Plugin + +Here's a sample plugin, for your reference: + + package App::Prove::Plugin::Foo; + + # Sample plugin, try running with: + # prove -PFoo=bar -r -j3 + # prove -PFoo -Q + # prove -PFoo=bar,My::Formatter + + use strict; + use warnings; + + sub load { + my ($class, $p) = @_; + my @args = @{ $p->{args} }; + my $app = $p->{app_prove}; + + print "loading plugin: $class, args: ", join(', ', @args ), "\n"; + + # turn on verbosity + $app->verbose( 1 ); + + # set the formatter? + $app->formatter( $args[1] ) if @args > 1; + + # print some of App::Prove's state: + for my $attr (qw( jobs quiet really_quiet recurse verbose )) { + my $val = $app->$attr; + $val = 'undef' unless defined( $val ); + print "$attr: $val\n"; + } + + return 1; + } + + 1; + +=head1 SEE ALSO + +L, L + +=cut diff --git a/lib/App/Prove/State.pm b/lib/App/Prove/State.pm new file mode 100644 index 0000000..0b61a82 --- /dev/null +++ b/lib/App/Prove/State.pm @@ -0,0 +1,548 @@ +package App::Prove::State; + +use strict; +use warnings; + +use File::Find; +use File::Spec; +use Carp; + +use App::Prove::State::Result; +use TAP::Parser::YAMLish::Reader (); +use TAP::Parser::YAMLish::Writer (); +use base 'TAP::Base'; + +BEGIN { + __PACKAGE__->mk_methods('result_class'); +} + +use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); +use constant NEED_GLOB => IS_WIN32; + +=head1 NAME + +App::Prove::State - State storage for the C command. + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +The C command supports a C<--state> option that instructs it to +store persistent state across runs. This module implements that state +and the operations that may be performed on it. + +=head1 SYNOPSIS + + # Re-run failed tests + $ prove --state=failed,save -rbv + +=cut + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +Accepts a hashref with the following key/value pairs: + +=over 4 + +=item * C + +The filename of the data store holding the data that App::Prove::State reads. + +=item * C (optional) + +The test name extensions. Defaults to C<.t>. + +=item * C (optional) + +The name of the C. Defaults to C. + +=back + +=cut + +# override TAP::Base::new: +sub new { + my $class = shift; + my %args = %{ shift || {} }; + + my $self = bless { + select => [], + seq => 1, + store => delete $args{store}, + extensions => ( delete $args{extensions} || ['.t'] ), + result_class => + ( delete $args{result_class} || 'App::Prove::State::Result' ), + }, $class; + + $self->{_} = $self->result_class->new( + { tests => {}, + generation => 1, + } + ); + my $store = $self->{store}; + $self->load($store) + if defined $store && -f $store; + + return $self; +} + +=head2 C + +Getter/setter for the name of the class used for tracking test results. This +class should either subclass from C or provide an +identical interface. + +=cut + +=head2 C + +Get or set the list of extensions that files must have in order to be +considered tests. Defaults to ['.t']. + +=cut + +sub extensions { + my $self = shift; + $self->{extensions} = shift if @_; + return $self->{extensions}; +} + +=head2 C + +Get the results of the last test run. Returns a C instance. + +=cut + +sub results { + my $self = shift; + $self->{_} || $self->result_class->new; +} + +=head2 C + +Save the test results. Should be called after all tests have run. + +=cut + +sub commit { + my $self = shift; + if ( $self->{should_save} ) { + $self->save; + } +} + +=head2 Instance Methods + +=head3 C + + $self->apply_switch('failed,save'); + +Apply a list of switch options to the state, updating the internal +object state as a result. Nothing is returned. + +Diagnostics: + - "Illegal state option: %s" + +=over + +=item C + +Run in the same order as last time + +=item C + +Run only the failed tests from last time + +=item C + +Run only the passed tests from last time + +=item C + +Run all tests in normal order + +=item C + +Run the tests that most recently failed first + +=item C + +Run the tests ordered by number of todos. + +=item C + +Run the tests in slowest to fastest order. + +=item C + +Run test tests in fastest to slowest order. + +=item C + +Run the tests in newest to oldest order. + +=item C + +Run the tests in oldest to newest order. + +=item C + +Save the state on exit. + +=back + +=cut + +sub apply_switch { + my $self = shift; + my @opts = @_; + + my $last_gen = $self->results->generation - 1; + my $last_run_time = $self->results->last_run_time; + my $now = $self->get_time; + + my @switches = map { split /,/ } @opts; + + my %handler = ( + last => sub { + $self->_select( + limit => shift, + where => sub { $_->generation >= $last_gen }, + order => sub { $_->sequence } + ); + }, + failed => sub { + $self->_select( + limit => shift, + where => sub { $_->result != 0 }, + order => sub { -$_->result } + ); + }, + passed => sub { + $self->_select( + limit => shift, + where => sub { $_->result == 0 } + ); + }, + all => sub { + $self->_select( limit => shift ); + }, + todo => sub { + $self->_select( + limit => shift, + where => sub { $_->num_todo != 0 }, + order => sub { -$_->num_todo; } + ); + }, + hot => sub { + $self->_select( + limit => shift, + where => sub { defined $_->last_fail_time }, + order => sub { $now - $_->last_fail_time } + ); + }, + slow => sub { + $self->_select( + limit => shift, + order => sub { -$_->elapsed } + ); + }, + fast => sub { + $self->_select( + limit => shift, + order => sub { $_->elapsed } + ); + }, + new => sub { + $self->_select( + limit => shift, + order => sub { -$_->mtime } + ); + }, + old => sub { + $self->_select( + limit => shift, + order => sub { $_->mtime } + ); + }, + fresh => sub { + $self->_select( + limit => shift, + where => sub { $_->mtime >= $last_run_time } + ); + }, + save => sub { + $self->{should_save}++; + }, + adrian => sub { + unshift @switches, qw( hot all save ); + }, + ); + + while ( defined( my $ele = shift @switches ) ) { + my ( $opt, $arg ) + = ( $ele =~ /^([^:]+):(.*)/ ) + ? ( $1, $2 ) + : ( $ele, undef ); + my $code = $handler{$opt} + || croak "Illegal state option: $opt"; + $code->($arg); + } + return; +} + +sub _select { + my ( $self, %spec ) = @_; + push @{ $self->{select} }, \%spec; +} + +=head3 C + +Given a list of args get the names of tests that should run + +=cut + +sub get_tests { + my $self = shift; + my $recurse = shift; + my @argv = @_; + my %seen; + + my @selected = $self->_query; + + unless ( @argv || @{ $self->{select} } ) { + @argv = $recurse ? '.' : 't'; + croak qq{No tests named and '@argv' directory not found} + unless -d $argv[0]; + } + + push @selected, $self->_get_raw_tests( $recurse, @argv ) if @argv; + return grep { !$seen{$_}++ } @selected; +} + +sub _query { + my $self = shift; + if ( my @sel = @{ $self->{select} } ) { + warn "No saved state, selection will be empty\n" + unless $self->results->num_tests; + return map { $self->_query_clause($_) } @sel; + } + return; +} + +sub _query_clause { + my ( $self, $clause ) = @_; + my @got; + my $results = $self->results; + my $where = $clause->{where} || sub {1}; + + # Select + for my $name ( $results->test_names ) { + next unless -f $name; + local $_ = $results->test($name); + push @got, $name if $where->(); + } + + # Sort + if ( my $order = $clause->{order} ) { + @got = map { $_->[0] } + sort { + ( defined $b->[1] <=> defined $a->[1] ) + || ( ( $a->[1] || 0 ) <=> ( $b->[1] || 0 ) ) + } map { + [ $_, + do { local $_ = $results->test($_); $order->() } + ] + } @got; + } + + if ( my $limit = $clause->{limit} ) { + @got = splice @got, 0, $limit if @got > $limit; + } + + return @got; +} + +sub _get_raw_tests { + my $self = shift; + my $recurse = shift; + my @argv = @_; + my @tests; + + # Do globbing on Win32. + if (NEED_GLOB) { + eval "use File::Glob::Windows"; # [49732] + @argv = map { glob "$_" } @argv; + } + my $extensions = $self->{extensions}; + + for my $arg (@argv) { + if ( '-' eq $arg ) { + push @argv => ; + chomp(@argv); + next; + } + + push @tests, + sort -d $arg + ? $recurse + ? $self->_expand_dir_recursive( $arg, $extensions ) + : map { glob( File::Spec->catfile( $arg, "*$_" ) ) } + @{$extensions} + : $arg; + } + return @tests; +} + +sub _expand_dir_recursive { + my ( $self, $dir, $extensions ) = @_; + + my @tests; + my $ext_string = join( '|', map {quotemeta} @{$extensions} ); + + find( + { follow => 1, #21938 + follow_skip => 2, + wanted => sub { + -f + && /(?:$ext_string)$/ + && push @tests => $File::Find::name; + } + }, + $dir + ); + return @tests; +} + +=head3 C + +Store the results of a test. + +=cut + +# Store: +# last fail time +# last pass time +# last run time +# most recent result +# most recent todos +# total failures +# total passes +# state generation +# parser + +sub observe_test { + + my ( $self, $test_info, $parser ) = @_; + my $name = $test_info->[0]; + my $fail = scalar( $parser->failed ) + ( $parser->has_problems ? 1 : 0 ); + my $todo = scalar( $parser->todo ); + my $start_time = $parser->start_time; + my $end_time = $parser->end_time, + + my $test = $self->results->test($name); + + $test->sequence( $self->{seq}++ ); + $test->generation( $self->results->generation ); + + $test->run_time($end_time); + $test->result($fail); + $test->num_todo($todo); + $test->elapsed( $end_time - $start_time ); + + $test->parser($parser); + + if ($fail) { + $test->total_failures( $test->total_failures + 1 ); + $test->last_fail_time($end_time); + } + else { + $test->total_passes( $test->total_passes + 1 ); + $test->last_pass_time($end_time); + } +} + +=head3 C + +Write the state to a file. + +=cut + +sub save { + my ($self) = @_; + + my $store = $self->{store} or return; + $self->results->last_run_time( $self->get_time ); + + my $writer = TAP::Parser::YAMLish::Writer->new; + local *FH; + open FH, ">$store" or croak "Can't write $store ($!)"; + $writer->write( $self->results->raw, \*FH ); + close FH; +} + +=head3 C + +Load the state from a file + +=cut + +sub load { + my ( $self, $name ) = @_; + my $reader = TAP::Parser::YAMLish::Reader->new; + local *FH; + open FH, "<$name" or croak "Can't read $name ($!)"; + + # XXX this is temporary + $self->{_} = $self->result_class->new( + $reader->read( + sub { + my $line = ; + defined $line && chomp $line; + return $line; + } + ) + ); + + # $writer->write( $self->{tests} || {}, \*FH ); + close FH; + $self->_regen_seq; + $self->_prune_and_stamp; + $self->results->generation( $self->results->generation + 1 ); +} + +sub _prune_and_stamp { + my $self = shift; + + my $results = $self->results; + my @tests = $self->results->tests; + for my $test (@tests) { + my $name = $test->name; + if ( my @stat = stat $name ) { + $test->mtime( $stat[9] ); + } + else { + $results->remove($name); + } + } +} + +sub _regen_seq { + my $self = shift; + for my $test ( $self->results->tests ) { + $self->{seq} = $test->sequence + 1 + if defined $test->sequence && $test->sequence >= $self->{seq}; + } +} + +1; diff --git a/lib/App/Prove/State/Result.pm b/lib/App/Prove/State/Result.pm new file mode 100644 index 0000000..8f89c77 --- /dev/null +++ b/lib/App/Prove/State/Result.pm @@ -0,0 +1,233 @@ +package App::Prove::State::Result; + +use strict; +use warnings; +use Carp 'croak'; + +use App::Prove::State::Result::Test; + +use constant STATE_VERSION => 1; + +=head1 NAME + +App::Prove::State::Result - Individual test suite results. + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +The C command supports a C<--state> option that instructs it to +store persistent state across runs. This module encapsulates the results for a +single test suite run. + +=head1 SYNOPSIS + + # Re-run failed tests + $ prove --state=failed,save -rbv + +=cut + +=head1 METHODS + +=head2 Class Methods + +=head3 C + + my $result = App::Prove::State::Result->new({ + generation => $generation, + tests => \%tests, + }); + +Returns a new C instance. + +=cut + +sub new { + my ( $class, $arg_for ) = @_; + $arg_for ||= {}; + my %instance_data = %$arg_for; # shallow copy + $instance_data{version} = $class->state_version; + my $tests = delete $instance_data{tests} || {}; + my $self = bless \%instance_data => $class; + $self->_initialize($tests); + return $self; +} + +sub _initialize { + my ( $self, $tests ) = @_; + my %tests; + while ( my ( $name, $test ) = each %$tests ) { + $tests{$name} = $self->test_class->new( + { %$test, + name => $name + } + ); + } + $self->tests( \%tests ); + return $self; +} + +=head2 C + +Returns the current version of state storage. + +=cut + +sub state_version {STATE_VERSION} + +=head2 C + +Returns the name of the class used for tracking individual tests. This class +should either subclass from C or provide an +identical interface. + +=cut + +sub test_class { + return 'App::Prove::State::Result::Test'; +} + +my %methods = ( + generation => { method => 'generation', default => 0 }, + last_run_time => { method => 'last_run_time', default => undef }, +); + +while ( my ( $key, $description ) = each %methods ) { + my $default = $description->{default}; + no strict 'refs'; + *{ $description->{method} } = sub { + my $self = shift; + if (@_) { + $self->{$key} = shift; + return $self; + } + return $self->{$key} || $default; + }; +} + +=head3 C + +Getter/setter for the "generation" of the test suite run. The first +generation is 1 (one) and subsequent generations are 2, 3, etc. + +=head3 C + +Getter/setter for the time of the test suite run. + +=head3 C + +Returns the tests for a given generation. This is a hashref or a hash, +depending on context called. The keys to the hash are the individual +test names and the value is a hashref with various interesting values. +Each k/v pair might resemble something like this: + + 't/foo.t' => { + elapsed => '0.0428488254547119', + gen => '7', + last_pass_time => '1219328376.07815', + last_result => '0', + last_run_time => '1219328376.07815', + last_todo => '0', + mtime => '1191708862', + seq => '192', + total_passes => '6', + } + +=cut + +sub tests { + my $self = shift; + if (@_) { + $self->{tests} = shift; + return $self; + } + my %tests = %{ $self->{tests} }; + my @tests = sort { $a->sequence <=> $b->sequence } values %tests; + return wantarray ? @tests : \@tests; +} + +=head3 C + + my $test = $result->test('t/customer/create.t'); + +Returns an individual C instance for the +given test name (usually the filename). Will return a new +C instance if the name is not found. + +=cut + +sub test { + my ( $self, $name ) = @_; + croak("test() requires a test name") unless defined $name; + + my $tests = $self->{tests} ||= {}; + if ( my $test = $tests->{$name} ) { + return $test; + } + else { + my $test = $self->test_class->new( { name => $name } ); + $self->{tests}->{$name} = $test; + return $test; + } +} + +=head3 C + +Returns an list of test names, sorted by run order. + +=cut + +sub test_names { + my $self = shift; + return map { $_->name } $self->tests; +} + +=head3 C + + $result->remove($test_name); # remove the test + my $test = $result->test($test_name); # fatal error + +Removes a given test from results. This is a no-op if the test name is not +found. + +=cut + +sub remove { + my ( $self, $name ) = @_; + delete $self->{tests}->{$name}; + return $self; +} + +=head3 C + +Returns the number of tests for a given test suite result. + +=cut + +sub num_tests { keys %{ shift->{tests} } } + +=head3 C + +Returns a hashref of raw results, suitable for serialization by YAML. + +=cut + +sub raw { + my $self = shift; + my %raw = %$self; + + my %tests; + for my $test ( $self->tests ) { + $tests{ $test->name } = $test->raw; + } + $raw{tests} = \%tests; + return \%raw; +} + +1; diff --git a/lib/App/Prove/State/Result/Test.pm b/lib/App/Prove/State/Result/Test.pm new file mode 100644 index 0000000..b795280 --- /dev/null +++ b/lib/App/Prove/State/Result/Test.pm @@ -0,0 +1,152 @@ +package App::Prove::State::Result::Test; + +use strict; +use warnings; + +=head1 NAME + +App::Prove::State::Result::Test - Individual test results. + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +The C command supports a C<--state> option that instructs it to +store persistent state across runs. This module encapsulates the results for a +single test. + +=head1 SYNOPSIS + + # Re-run failed tests + $ prove --state=failed,save -rbv + +=cut + +my %methods = ( + name => { method => 'name' }, + elapsed => { method => 'elapsed', default => 0 }, + gen => { method => 'generation', default => 1 }, + last_pass_time => { method => 'last_pass_time', default => undef }, + last_fail_time => { method => 'last_fail_time', default => undef }, + last_result => { method => 'result', default => 0 }, + last_run_time => { method => 'run_time', default => undef }, + last_todo => { method => 'num_todo', default => 0 }, + mtime => { method => 'mtime', default => undef }, + seq => { method => 'sequence', default => 1 }, + total_passes => { method => 'total_passes', default => 0 }, + total_failures => { method => 'total_failures', default => 0 }, + parser => { method => 'parser' }, +); + +while ( my ( $key, $description ) = each %methods ) { + my $default = $description->{default}; + no strict 'refs'; + *{ $description->{method} } = sub { + my $self = shift; + if (@_) { + $self->{$key} = shift; + return $self; + } + return $self->{$key} || $default; + }; +} + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +=cut + +sub new { + my ( $class, $arg_for ) = @_; + $arg_for ||= {}; + bless $arg_for => $class; +} + +=head2 Instance Methods + +=head3 C + +The name of the test. Usually a filename. + +=head3 C + +The total elapsed times the test took to run, in seconds from the epoch.. + +=head3 C + +The number for the "generation" of the test run. The first generation is 1 +(one) and subsequent generations are 2, 3, etc. + +=head3 C + +The last time the test program passed, in seconds from the epoch. + +Returns C if the program has never passed. + +=head3 C + +The last time the test suite failed, in seconds from the epoch. + +Returns C if the program has never failed. + +=head3 C + +Returns the mtime of the test, in seconds from the epoch. + +=head3 C + +Returns a hashref of raw test data, suitable for serialization by YAML. + +=head3 C + +Currently, whether or not the test suite passed with no 'problems' (such as +TODO passed). + +=head3 C + +The total time it took for the test to run, in seconds. If C is +available, it will have finer granularity. + +=head3 C + +The number of tests with TODO directives. + +=head3 C + +The order in which this test was run for the given test suite result. + +=head3 C + +The number of times the test has passed. + +=head3 C + +The number of times the test has failed. + +=head3 C + +The underlying parser object. This is useful if you need the full +information for the test program. + +=cut + +sub raw { + my $self = shift; + my %raw = %$self; + + # this is backwards-compatibility hack and is not guaranteed. + delete $raw{name}; + delete $raw{parser}; + return \%raw; +} + +1; diff --git a/lib/TAP/Base.pm b/lib/TAP/Base.pm new file mode 100644 index 0000000..78e07ab --- /dev/null +++ b/lib/TAP/Base.pm @@ -0,0 +1,133 @@ +package TAP::Base; + +use strict; +use warnings; + +use base 'TAP::Object'; + +=head1 NAME + +TAP::Base - Base class that provides common functionality to L +and L + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +use constant GOT_TIME_HIRES => do { + eval 'use Time::HiRes qw(time);'; + $@ ? 0 : 1; +}; + +=head1 SYNOPSIS + + package TAP::Whatever; + + use base 'TAP::Base'; + + # ... later ... + + my $thing = TAP::Whatever->new(); + + $thing->callback( event => sub { + # do something interesting + } ); + +=head1 DESCRIPTION + +C provides callback management. + +=head1 METHODS + +=head2 Class Methods + +=cut + +sub _initialize { + my ( $self, $arg_for, $ok_callback ) = @_; + + my %ok_map = map { $_ => 1 } @$ok_callback; + + $self->{ok_callbacks} = \%ok_map; + + if ( my $cb = delete $arg_for->{callbacks} ) { + while ( my ( $event, $callback ) = each %$cb ) { + $self->callback( $event, $callback ); + } + } + + return $self; +} + +=head3 C + +Install a callback for a named event. + +=cut + +sub callback { + my ( $self, $event, $callback ) = @_; + + my %ok_map = %{ $self->{ok_callbacks} }; + + $self->_croak('No callbacks may be installed') + unless %ok_map; + + $self->_croak( "Callback $event is not supported. Valid callbacks are " + . join( ', ', sort keys %ok_map ) ) + unless exists $ok_map{$event}; + + push @{ $self->{code_for}{$event} }, $callback; + + return; +} + +sub _has_callbacks { + my $self = shift; + return keys %{ $self->{code_for} } != 0; +} + +sub _callback_for { + my ( $self, $event ) = @_; + return $self->{code_for}{$event}; +} + +sub _make_callback { + my $self = shift; + my $event = shift; + + my $cb = $self->_callback_for($event); + return unless defined $cb; + return map { $_->(@_) } @$cb; +} + +=head3 C + +Return the current time using Time::HiRes if available. + +=cut + +sub get_time { return time() } + +=head3 C + +Return true if the time returned by get_time is high resolution (i.e. if Time::HiRes is available). + +=cut + +sub time_is_hires { return GOT_TIME_HIRES } + +=head3 C + +Return array reference of the four-element list of CPU seconds, +as with L. + +=cut + +sub get_times { return [ times() ] } + +1; diff --git a/lib/TAP/Formatter/Base.pm b/lib/TAP/Formatter/Base.pm new file mode 100644 index 0000000..bf65e12 --- /dev/null +++ b/lib/TAP/Formatter/Base.pm @@ -0,0 +1,467 @@ +package TAP::Formatter::Base; + +use strict; +use warnings; +use base 'TAP::Base'; +use POSIX qw(strftime); + +my $MAX_ERRORS = 5; +my %VALIDATION_FOR; + +BEGIN { + %VALIDATION_FOR = ( + directives => sub { shift; shift }, + verbosity => sub { shift; shift }, + normalize => sub { shift; shift }, + timer => sub { shift; shift }, + failures => sub { shift; shift }, + comments => sub { shift; shift }, + errors => sub { shift; shift }, + color => sub { shift; shift }, + jobs => sub { shift; shift }, + show_count => sub { shift; shift }, + stdout => sub { + my ( $self, $ref ) = @_; + + $self->_croak("option 'stdout' needs a filehandle") + unless $self->_is_filehandle($ref); + + return $ref; + }, + ); + + sub _is_filehandle { + my ( $self, $ref ) = @_; + + return 0 if !defined $ref; + + return 1 if ref $ref eq 'GLOB'; # lexical filehandle + return 1 if !ref $ref && ref \$ref eq 'GLOB'; # bare glob like *STDOUT + + return 1 if eval { $ref->can('print') }; + + return 0; + } + + my @getter_setters = qw( + _longest + _printed_summary_header + _colorizer + ); + + __PACKAGE__->mk_methods( @getter_setters, keys %VALIDATION_FOR ); +} + +=head1 NAME + +TAP::Formatter::Base - Base class for harness output delegates + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +This provides console orientated output formatting for TAP::Harness. + +=head1 SYNOPSIS + + use TAP::Formatter::Console; + my $harness = TAP::Formatter::Console->new( \%args ); + +=cut + +sub _initialize { + my ( $self, $arg_for ) = @_; + $arg_for ||= {}; + + $self->SUPER::_initialize($arg_for); + my %arg_for = %$arg_for; # force a shallow copy + + $self->verbosity(0); + + for my $name ( keys %VALIDATION_FOR ) { + my $property = delete $arg_for{$name}; + if ( defined $property ) { + my $validate = $VALIDATION_FOR{$name}; + $self->$name( $self->$validate($property) ); + } + } + + if ( my @props = keys %arg_for ) { + $self->_croak( + "Unknown arguments to " . __PACKAGE__ . "::new (@props)" ); + } + + $self->stdout( \*STDOUT ) unless $self->stdout; + + if ( $self->color ) { + require TAP::Formatter::Color; + $self->_colorizer( TAP::Formatter::Color->new ); + } + + return $self; +} + +sub verbose { shift->verbosity >= 1 } +sub quiet { shift->verbosity <= -1 } +sub really_quiet { shift->verbosity <= -2 } +sub silent { shift->verbosity <= -3 } + +=head1 METHODS + +=head2 Class Methods + +=head3 C + + my %args = ( + verbose => 1, + ) + my $harness = TAP::Formatter::Console->new( \%args ); + +The constructor returns a new C object. If +a L is created with no C a +C is automatically created. If any of the +following options were given to TAP::Harness->new they well be passed to +this constructor which accepts an optional hashref whose allowed keys are: + +=over 4 + +=item * C + +Set the verbosity level. + +=item * C + +Printing individual test results to STDOUT. + +=item * C + +Append run time for each test to output. Uses L if available. + +=item * C + +Show test failures (this is a no-op if C is selected). + +=item * C + +Show test comments (this is a no-op if C is selected). + +=item * C + +Suppressing some test output (mostly failures while tests are running). + +=item * C + +Suppressing everything but the tests summary. + +=item * C + +Suppressing all output. + +=item * C + +If parse errors are found in the TAP output, a note of this will be made +in the summary report. To see all of the parse errors, set this argument to +true: + + errors => 1 + +=item * C + +If set to a true value, only test results with directives will be displayed. +This overrides other settings such as C, C, or C. + +=item * C + +A filehandle for catching standard output. + +=item * C + +If defined specifies whether color output is desired. If C is not +defined it will default to color output if color support is available on +the current platform and output is not being redirected. + +=item * C + +The number of concurrent jobs this formatter will handle. + +=item * C + +Boolean value. If false, disables the C test count which shows up while +tests are running. + +=back + +Any keys for which the value is C will be ignored. + +=cut + +# new supplied by TAP::Base + +=head3 C + +Called by Test::Harness before any test output is generated. + +This is an advisory and may not be called in the case where tests are +being supplied to Test::Harness by an iterator. + +=cut + +sub prepare { + my ( $self, @tests ) = @_; + + my $longest = 0; + + for my $test (@tests) { + $longest = length $test if length $test > $longest; + } + + $self->_longest($longest); +} + +sub _format_now { strftime "[%H:%M:%S]", localtime } + +sub _format_name { + my ( $self, $test ) = @_; + my $name = $test; + my $periods = '.' x ( $self->_longest + 2 - length $test ); + $periods = " $periods "; + + if ( $self->timer ) { + my $stamp = $self->_format_now(); + return "$stamp $name$periods"; + } + else { + return "$name$periods"; + } + +} + +=head3 C + +Called to create a new test session. A test session looks like this: + + my $session = $formatter->open_test( $test, $parser ); + while ( defined( my $result = $parser->next ) ) { + $session->result($result); + exit 1 if $result->is_bailout; + } + $session->close_test; + +=cut + +sub open_test { + die "Unimplemented."; +} + +sub _output_success { + my ( $self, $msg ) = @_; + $self->_output($msg); +} + +=head3 C + + $harness->summary( $aggregate ); + +C prints the summary report after all tests are run. The first +argument is an aggregate to summarise. An optional second argument may +be set to a true value to indicate that the summary is being output as a +result of an interrupted test run. + +=cut + +sub summary { + my ( $self, $aggregate, $interrupted ) = @_; + + return if $self->silent; + + my @t = $aggregate->descriptions; + my $tests = \@t; + + my $runtime = $aggregate->elapsed_timestr; + + my $total = $aggregate->total; + my $passed = $aggregate->passed; + + if ( $self->timer ) { + $self->_output( $self->_format_now(), "\n" ); + } + + $self->_failure_output("Test run interrupted!\n") + if $interrupted; + + # TODO: Check this condition still works when all subtests pass but + # the exit status is nonzero + + if ( $aggregate->all_passed ) { + $self->_output_success("All tests successful.\n"); + } + + # ~TODO option where $aggregate->skipped generates reports + if ( $total != $passed or $aggregate->has_problems ) { + $self->_output("\nTest Summary Report"); + $self->_output("\n-------------------\n"); + for my $test (@$tests) { + $self->_printed_summary_header(0); + my ($parser) = $aggregate->parsers($test); + $self->_output_summary_failure( + 'failed', + [ ' Failed test: ', ' Failed tests: ' ], + $test, $parser + ); + $self->_output_summary_failure( + 'todo_passed', + " TODO passed: ", $test, $parser + ); + + # ~TODO this cannot be the default + #$self->_output_summary_failure( 'skipped', " Tests skipped: " ); + + if ( my $exit = $parser->exit ) { + $self->_summary_test_header( $test, $parser ); + $self->_failure_output(" Non-zero exit status: $exit\n"); + } + elsif ( my $wait = $parser->wait ) { + $self->_summary_test_header( $test, $parser ); + $self->_failure_output(" Non-zero wait status: $wait\n"); + } + + if ( my @errors = $parser->parse_errors ) { + my $explain; + if ( @errors > $MAX_ERRORS && !$self->errors ) { + $explain + = "Displayed the first $MAX_ERRORS of " + . scalar(@errors) + . " TAP syntax errors.\n" + . "Re-run prove with the -p option to see them all.\n"; + splice @errors, $MAX_ERRORS; + } + $self->_summary_test_header( $test, $parser ); + $self->_failure_output( + sprintf " Parse errors: %s\n", + shift @errors + ); + for my $error (@errors) { + my $spaces = ' ' x 16; + $self->_failure_output("$spaces$error\n"); + } + $self->_failure_output($explain) if $explain; + } + } + } + my $files = @$tests; + $self->_output("Files=$files, Tests=$total, $runtime\n"); + my $status = $aggregate->get_status; + $self->_output("Result: $status\n"); +} + +sub _output_summary_failure { + my ( $self, $method, $name, $test, $parser ) = @_; + + # ugly hack. Must rethink this :( + my $output = $method eq 'failed' ? '_failure_output' : '_output'; + + if ( my @r = $parser->$method() ) { + $self->_summary_test_header( $test, $parser ); + my ( $singular, $plural ) + = 'ARRAY' eq ref $name ? @$name : ( $name, $name ); + $self->$output( @r == 1 ? $singular : $plural ); + my @results = $self->_balanced_range( 40, @r ); + $self->$output( sprintf "%s\n" => shift @results ); + my $spaces = ' ' x 16; + while (@results) { + $self->$output( sprintf "$spaces%s\n" => shift @results ); + } + } +} + +sub _summary_test_header { + my ( $self, $test, $parser ) = @_; + return if $self->_printed_summary_header; + my $spaces = ' ' x ( $self->_longest - length $test ); + $spaces = ' ' unless $spaces; + my $output = $self->_get_output_method($parser); + my $wait = $parser->wait; + defined $wait or $wait = '(none)'; + $self->$output( + sprintf "$test$spaces(Wstat: %s Tests: %d Failed: %d)\n", + $wait, $parser->tests_run, scalar $parser->failed + ); + $self->_printed_summary_header(1); +} + +sub _output { + my $self = shift; + + print { $self->stdout } @_; +} + +sub _failure_output { + my $self = shift; + + $self->_output(@_); +} + +sub _balanced_range { + my ( $self, $limit, @range ) = @_; + @range = $self->_range(@range); + my $line = ""; + my @lines; + my $curr = 0; + while (@range) { + if ( $curr < $limit ) { + my $range = ( shift @range ) . ", "; + $line .= $range; + $curr += length $range; + } + elsif (@range) { + $line =~ s/, $//; + push @lines => $line; + $line = ''; + $curr = 0; + } + } + if ($line) { + $line =~ s/, $//; + push @lines => $line; + } + return @lines; +} + +sub _range { + my ( $self, @numbers ) = @_; + + # shouldn't be needed, but subclasses might call this + @numbers = sort { $a <=> $b } @numbers; + my ( $min, @range ); + + for my $i ( 0 .. $#numbers ) { + my $num = $numbers[$i]; + my $next = $numbers[ $i + 1 ]; + if ( defined $next && $next == $num + 1 ) { + if ( !defined $min ) { + $min = $num; + } + } + elsif ( defined $min ) { + push @range => "$min-$num"; + undef $min; + } + else { + push @range => $num; + } + } + return @range; +} + +sub _get_output_method { + my ( $self, $parser ) = @_; + return $parser->has_problems ? '_failure_output' : '_output'; +} + +1; diff --git a/lib/TAP/Formatter/Color.pm b/lib/TAP/Formatter/Color.pm new file mode 100644 index 0000000..7980790 --- /dev/null +++ b/lib/TAP/Formatter/Color.pm @@ -0,0 +1,116 @@ +package TAP::Formatter::Color; + +use strict; +use warnings; + +use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); + +use base 'TAP::Object'; + +my $NO_COLOR; + +BEGIN { + $NO_COLOR = 0; + + eval 'require Term::ANSIColor'; + if ($@) { + $NO_COLOR = $@; + }; + if (IS_WIN32) { + eval 'use Win32::Console::ANSI'; + if ($@) { + $NO_COLOR = $@; + } + }; + + if ($NO_COLOR) { + *set_color = sub { }; + } else { + *set_color = sub { + my ( $self, $output, $color ) = @_; + $output->( Term::ANSIColor::color($color) ); + }; + } +} + +=head1 NAME + +TAP::Formatter::Color - Run Perl test scripts with color + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +Note that this harness is I. You may not like the colors I've +chosen and I haven't yet provided an easy way to override them. + +This test harness is the same as L, but test results are output +in color. Passing tests are printed in green. Failing tests are in red. +Skipped tests are blue on a white background and TODO tests are printed in +white. + +If L cannot be found (and L if running +under Windows) tests will be run without color. + +=head1 SYNOPSIS + + use TAP::Formatter::Color; + my $harness = TAP::Formatter::Color->new( \%args ); + $harness->runtests(@tests); + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +The constructor returns a new C object. If +L is not installed, returns undef. + +=cut + +# new() implementation supplied by TAP::Object + +sub _initialize { + my $self = shift; + + if ($NO_COLOR) { + + # shorten that message a bit + ( my $error = $NO_COLOR ) =~ s/ in \@INC .*//s; + warn "Note: Cannot run tests in color: $error\n"; + return; # abort object construction + } + + return $self; +} + +############################################################################## + +=head3 C + + Test::Formatter::Color->can_color() + +Returns a boolean indicating whether or not this module can actually +generate colored output. This will be false if it could not load the +modules needed for the current platform. + +=cut + +sub can_color { + return !$NO_COLOR; +} + +=head3 C + +Set the output color. + +=cut + +1; diff --git a/lib/TAP/Formatter/Console.pm b/lib/TAP/Formatter/Console.pm new file mode 100644 index 0000000..1c82ef4 --- /dev/null +++ b/lib/TAP/Formatter/Console.pm @@ -0,0 +1,100 @@ +package TAP::Formatter::Console; + +use strict; +use warnings; +use base 'TAP::Formatter::Base'; +use POSIX qw(strftime); + +=head1 NAME + +TAP::Formatter::Console - Harness output delegate for default console output + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +This provides console orientated output formatting for TAP::Harness. + +=head1 SYNOPSIS + + use TAP::Formatter::Console; + my $harness = TAP::Formatter::Console->new( \%args ); + +=head2 C<< open_test >> + +See L + +=cut + +sub open_test { + my ( $self, $test, $parser ) = @_; + + my $class + = $self->jobs > 1 + ? 'TAP::Formatter::Console::ParallelSession' + : 'TAP::Formatter::Console::Session'; + + eval "require $class"; + $self->_croak($@) if $@; + + my $session = $class->new( + { name => $test, + formatter => $self, + parser => $parser, + show_count => $self->show_count, + } + ); + + $session->header; + + return $session; +} + +# Use _colorizer delegate to set output color. NOP if we have no delegate +sub _set_colors { + my ( $self, @colors ) = @_; + if ( my $colorizer = $self->_colorizer ) { + my $output_func = $self->{_output_func} ||= sub { + $self->_output(@_); + }; + $colorizer->set_color( $output_func, $_ ) for @colors; + } +} + +sub _failure_color { + my ($self) = @_; + + return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red'; +} + +sub _success_color { + my ($self) = @_; + + return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green'; +} + +sub _output_success { + my ( $self, $msg ) = @_; + $self->_set_colors( $self->_success_color() ); + $self->_output($msg); + $self->_set_colors('reset'); +} + +sub _failure_output { + my $self = shift; + $self->_set_colors( $self->_failure_color() ); + my $out = join '', @_; + my $has_newline = chomp $out; + $self->_output($out); + $self->_set_colors('reset'); + $self->_output($/) + if $has_newline; +} + +1; diff --git a/lib/TAP/Formatter/Console/ParallelSession.pm b/lib/TAP/Formatter/Console/ParallelSession.pm new file mode 100644 index 0000000..6826b4e --- /dev/null +++ b/lib/TAP/Formatter/Console/ParallelSession.pm @@ -0,0 +1,201 @@ +package TAP::Formatter::Console::ParallelSession; + +use strict; +use warnings; +use File::Spec; +use File::Path; +use Carp; + +use base 'TAP::Formatter::Console::Session'; + +use constant WIDTH => 72; # Because Eric says + +my %shared; + +sub _initialize { + my ( $self, $arg_for ) = @_; + + $self->SUPER::_initialize($arg_for); + my $formatter = $self->formatter; + + # Horrid bodge. This creates our shared context per harness. Maybe + # TAP::Harness should give us this? + my $context = $shared{$formatter} ||= $self->_create_shared_context; + push @{ $context->{active} }, $self; + + return $self; +} + +sub _create_shared_context { + my $self = shift; + return { + active => [], + tests => 0, + fails => 0, + }; +} + +=head1 NAME + +TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel console output + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +This provides console orientated output formatting for L +when run with multiple L. + +=head1 SYNOPSIS + +=cut + +=head1 METHODS + +=head2 Class Methods + +=head3 C
+ +Output test preamble + +=cut + +sub header { +} + +sub _clear_ruler { + my $self = shift; + $self->formatter->_output( "\r" . ( ' ' x WIDTH ) . "\r" ); +} + +my $now = 0; +my $start; + +my $trailer = '... )==='; +my $chop_length = WIDTH - length $trailer; + +sub _output_ruler { + my ( $self, $refresh ) = @_; + my $new_now = time; + return if $new_now == $now and !$refresh; + $now = $new_now; + $start ||= $now; + my $formatter = $self->formatter; + return if $formatter->really_quiet; + + my $context = $shared{$formatter}; + + my $ruler = sprintf '===( %7d;%d ', $context->{tests}, $now - $start; + + for my $active ( @{ $context->{active} } ) { + my $parser = $active->parser; + my $tests = $parser->tests_run; + my $planned = $parser->tests_planned || '?'; + + $ruler .= sprintf '%' . length($planned) . "d/$planned ", $tests; + } + chop $ruler; # Remove a trailing space + $ruler .= ')==='; + + if ( length $ruler > WIDTH ) { + $ruler =~ s/(.{$chop_length}).*/$1$trailer/o; + } + else { + $ruler .= '=' x ( WIDTH - length($ruler) ); + } + $formatter->_output("\r$ruler"); +} + +=head3 C + + Called by the harness for each line of TAP it receives . + +=cut + +sub result { + my ( $self, $result ) = @_; + my $formatter = $self->formatter; + + # my $really_quiet = $formatter->really_quiet; + # my $show_count = $self->_should_show_count; + + if ( $result->is_test ) { + my $context = $shared{$formatter}; + $context->{tests}++; + + my $active = $context->{active}; + if ( @$active == 1 ) { + + # There is only one test, so use the serial output format. + return $self->SUPER::result($result); + } + + $self->_output_ruler( $self->parser->tests_run == 1 ); + } + elsif ( $result->is_bailout ) { + $formatter->_failure_output( + "Bailout called. Further testing stopped: " + . $result->explanation + . "\n" ); + } +} + +=head3 C + +=cut + +sub clear_for_close { + my $self = shift; + my $formatter = $self->formatter; + return if $formatter->really_quiet; + my $context = $shared{$formatter}; + if ( @{ $context->{active} } == 1 ) { + $self->SUPER::clear_for_close; + } + else { + $self->_clear_ruler; + } +} + +=head3 C + +=cut + +sub close_test { + my $self = shift; + my $name = $self->name; + my $parser = $self->parser; + my $formatter = $self->formatter; + my $context = $shared{$formatter}; + + $self->SUPER::close_test; + + my $active = $context->{active}; + + my @pos = grep { $active->[$_]->name eq $name } 0 .. $#$active; + + die "Can't find myself" unless @pos; + splice @$active, $pos[0], 1; + + if ( @$active > 1 ) { + $self->_output_ruler(1); + } + elsif ( @$active == 1 ) { + + # Print out "test/name.t ...." + $active->[0]->SUPER::header; + } + else { + + # $self->formatter->_output("\n"); + delete $shared{$formatter}; + } +} + +1; diff --git a/lib/TAP/Formatter/Console/Session.pm b/lib/TAP/Formatter/Console/Session.pm new file mode 100644 index 0000000..492bdd7 --- /dev/null +++ b/lib/TAP/Formatter/Console/Session.pm @@ -0,0 +1,205 @@ +package TAP::Formatter::Console::Session; + +use strict; +use warnings; + +use base 'TAP::Formatter::Session'; + +my @ACCESSOR; + +BEGIN { + my @CLOSURE_BINDING = qw( header result clear_for_close close_test ); + + for my $method (@CLOSURE_BINDING) { + no strict 'refs'; + *$method = sub { + my $self = shift; + return ( $self->{_closures} ||= $self->_closures )->{$method} + ->(@_); + }; + } +} + +=head1 NAME + +TAP::Formatter::Console::Session - Harness output delegate for default console output + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +This provides console orientated output formatting for TAP::Harness. + +=cut + +sub _get_output_result { + my $self = shift; + + my @color_map = ( + { test => sub { $_->is_test && !$_->is_ok }, + colors => ['red'], + }, + { test => sub { $_->is_test && $_->has_skip }, + colors => [ + 'white', + 'on_blue' + ], + }, + { test => sub { $_->is_test && $_->has_todo }, + colors => ['yellow'], + }, + ); + + my $formatter = $self->formatter; + my $parser = $self->parser; + + return $formatter->_colorizer + ? sub { + my $result = shift; + for my $col (@color_map) { + local $_ = $result; + if ( $col->{test}->() ) { + $formatter->_set_colors( @{ $col->{colors} } ); + last; + } + } + $formatter->_output( $self->_format_for_output($result) ); + $formatter->_set_colors('reset'); + } + : sub { + $formatter->_output( $self->_format_for_output(shift) ); + }; +} + +sub _closures { + my $self = shift; + + my $parser = $self->parser; + my $formatter = $self->formatter; + my $pretty = $formatter->_format_name( $self->name ); + my $show_count = $self->show_count; + + my $really_quiet = $formatter->really_quiet; + my $quiet = $formatter->quiet; + my $verbose = $formatter->verbose; + my $directives = $formatter->directives; + my $failures = $formatter->failures; + my $comments = $formatter->comments; + + my $output_result = $self->_get_output_result; + + my $output = '_output'; + my $plan = ''; + my $newline_printed = 0; + + my $last_status_printed = 0; + + return { + header => sub { + $formatter->_output($pretty) + unless $really_quiet; + }, + + result => sub { + my $result = shift; + + if ( $result->is_bailout ) { + $formatter->_failure_output( + "Bailout called. Further testing stopped: " + . $result->explanation + . "\n" ); + } + + return if $really_quiet; + + my $is_test = $result->is_test; + + # These are used in close_test - but only if $really_quiet + # is false - so it's safe to only set them here unless that + # relationship changes. + + if ( !$plan ) { + my $planned = $parser->tests_planned || '?'; + $plan = "/$planned "; + } + $output = $formatter->_get_output_method($parser); + + if ( $show_count and $is_test ) { + my $number = $result->number; + my $now = CORE::time; + + # Print status roughly once per second. + # We will always get the first number as a side effect of + # $last_status_printed starting with the value 0, which $now + # will never be. (Unless someone sets their clock to 1970) + if ( $last_status_printed != $now ) { + $formatter->$output("\r$pretty$number$plan"); + $last_status_printed = $now; + } + } + + if (!$quiet + && ( $verbose + || ( $is_test && $failures && !$result->is_ok ) + || ( $comments && $result->is_comment ) + || ( $directives && $result->has_directive ) ) + ) + { + unless ($newline_printed) { + $formatter->_output("\n"); + $newline_printed = 1; + } + $output_result->($result); + $formatter->_output("\n"); + } + }, + + clear_for_close => sub { + my $spaces + = ' ' x length( '.' . $pretty . $plan . $parser->tests_run ); + $formatter->$output("\r$spaces"); + }, + + close_test => sub { + if ( $show_count && !$really_quiet ) { + $self->clear_for_close; + $formatter->$output("\r$pretty"); + } + + # Avoid circular references + $self->parser(undef); + $self->{_closures} = {}; + + return if $really_quiet; + + if ( my $skip_all = $parser->skip_all ) { + $formatter->_output("skipped: $skip_all\n"); + } + elsif ( $parser->has_problems ) { + $self->_output_test_failure($parser); + } + else { + my $time_report = $self->time_report($formatter, $parser); + $formatter->_output( $self->_make_ok_line($time_report) ); + } + }, + }; +} + +=head2 C<< clear_for_close >> + +=head2 C<< close_test >> + +=head2 C<< header >> + +=head2 C<< result >> + +=cut + +1; diff --git a/lib/TAP/Formatter/File.pm b/lib/TAP/Formatter/File.pm new file mode 100644 index 0000000..ced7b3f --- /dev/null +++ b/lib/TAP/Formatter/File.pm @@ -0,0 +1,56 @@ +package TAP::Formatter::File; + +use strict; +use warnings; +use TAP::Formatter::File::Session; +use POSIX qw(strftime); + +use base 'TAP::Formatter::Base'; + +=head1 NAME + +TAP::Formatter::File - Harness output delegate for file output + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +This provides file orientated output formatting for TAP::Harness. + +=head1 SYNOPSIS + + use TAP::Formatter::File; + my $harness = TAP::Formatter::File->new( \%args ); + +=head2 C<< open_test >> + +See L + +=cut + +sub open_test { + my ( $self, $test, $parser ) = @_; + + my $session = TAP::Formatter::File::Session->new( + { name => $test, + formatter => $self, + parser => $parser, + } + ); + + $session->header; + + return $session; +} + +sub _should_show_count { + return 0; +} + +1; diff --git a/lib/TAP/Formatter/File/Session.pm b/lib/TAP/Formatter/File/Session.pm new file mode 100644 index 0000000..3403540 --- /dev/null +++ b/lib/TAP/Formatter/File/Session.pm @@ -0,0 +1,95 @@ +package TAP::Formatter::File::Session; + +use strict; +use warnings; +use base 'TAP::Formatter::Session'; + +=head1 NAME + +TAP::Formatter::File::Session - Harness output delegate for file output + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 DESCRIPTION + +This provides file orientated output formatting for L. +It is particularly important when running with parallel tests, as it +ensures that test results are not interleaved, even when run +verbosely. + +=cut + +=head1 METHODS + +=head2 result + +Stores results for later output, all together. + +=cut + +sub result { + my $self = shift; + my $result = shift; + + my $parser = $self->parser; + my $formatter = $self->formatter; + + if ( $result->is_bailout ) { + $formatter->_failure_output( + "Bailout called. Further testing stopped: " + . $result->explanation + . "\n" ); + return; + } + + if (!$formatter->quiet + && ( $formatter->verbose + || ( $result->is_test && $formatter->failures && !$result->is_ok ) + || ( $formatter->comments && $result->is_comment ) + || ( $result->has_directive && $formatter->directives ) ) + ) + { + $self->{results} .= $self->_format_for_output($result) . "\n"; + } +} + +=head2 close_test + +When the test file finishes, outputs the summary, together. + +=cut + +sub close_test { + my $self = shift; + + # Avoid circular references + $self->parser(undef); + + my $parser = $self->parser; + my $formatter = $self->formatter; + my $pretty = $formatter->_format_name( $self->name ); + + return if $formatter->really_quiet; + if ( my $skip_all = $parser->skip_all ) { + $formatter->_output( $pretty . "skipped: $skip_all\n" ); + } + elsif ( $parser->has_problems ) { + $formatter->_output( + $pretty . ( $self->{results} ? "\n" . $self->{results} : "\n" ) ); + $self->_output_test_failure($parser); + } + else { + my $time_report = $self->time_report($formatter, $parser); + $formatter->_output( $pretty + . ( $self->{results} ? "\n" . $self->{results} : "" ) + . $self->_make_ok_line($time_report) ); + } +} + +1; diff --git a/lib/TAP/Formatter/Session.pm b/lib/TAP/Formatter/Session.pm new file mode 100644 index 0000000..2022220 --- /dev/null +++ b/lib/TAP/Formatter/Session.pm @@ -0,0 +1,220 @@ +package TAP::Formatter::Session; + +use strict; +use warnings; + +use base 'TAP::Base'; + +my @ACCESSOR; + +BEGIN { + + @ACCESSOR = qw( name formatter parser show_count ); + + for my $method (@ACCESSOR) { + no strict 'refs'; + *$method = sub { shift->{$method} }; + } +} + +=head1 NAME + +TAP::Formatter::Session - Abstract base class for harness output delegate + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 METHODS + +=head2 Class Methods + +=head3 C + + my %args = ( + formatter => $self, + ) + my $harness = TAP::Formatter::Console::Session->new( \%args ); + +The constructor returns a new C object. + +=over 4 + +=item * C + +=item * C + +=item * C + +=item * C + +=back + +=cut + +sub _initialize { + my ( $self, $arg_for ) = @_; + $arg_for ||= {}; + + $self->SUPER::_initialize($arg_for); + my %arg_for = %$arg_for; # force a shallow copy + + for my $name (@ACCESSOR) { + $self->{$name} = delete $arg_for{$name}; + } + + if ( !defined $self->show_count ) { + $self->{show_count} = 1; # defaults to true + } + if ( $self->show_count ) { # but may be a damned lie! + $self->{show_count} = $self->_should_show_count; + } + + if ( my @props = sort keys %arg_for ) { + $self->_croak( + "Unknown arguments to " . __PACKAGE__ . "::new (@props)" ); + } + + return $self; +} + +=head3 C
+ +Output test preamble + +=head3 C + +Called by the harness for each line of TAP it receives. + +=head3 C + +Called to close a test session. + +=head3 C + +Called by C to clear the line showing test progress, or the parallel +test ruler, prior to printing the final test result. + +=head3 C + +Return a formatted string about the elapsed (wall-clock) time +and about the consumed CPU time. + +=cut + +sub header { } + +sub result { } + +sub close_test { } + +sub clear_for_close { } + +sub _should_show_count { + my $self = shift; + return + !$self->formatter->verbose + && -t $self->formatter->stdout + && !$ENV{HARNESS_NOTTY}; +} + +sub _format_for_output { + my ( $self, $result ) = @_; + return $self->formatter->normalize ? $result->as_string : $result->raw; +} + +sub _output_test_failure { + my ( $self, $parser ) = @_; + my $formatter = $self->formatter; + return if $formatter->really_quiet; + + my $tests_run = $parser->tests_run; + my $tests_planned = $parser->tests_planned; + + my $total + = defined $tests_planned + ? $tests_planned + : $tests_run; + + my $passed = $parser->passed; + + # The total number of fails includes any tests that were planned but + # didn't run + my $failed = $parser->failed + $total - $tests_run; + my $exit = $parser->exit; + + if ( my $exit = $parser->exit ) { + my $wstat = $parser->wait; + my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat ); + $formatter->_failure_output("Dubious, test returned $status\n"); + } + + if ( $failed == 0 ) { + $formatter->_failure_output( + $total + ? "All $total subtests passed " + : 'No subtests run ' + ); + } + else { + $formatter->_failure_output("Failed $failed/$total subtests "); + if ( !$total ) { + $formatter->_failure_output("\nNo tests run!"); + } + } + + if ( my $skipped = $parser->skipped ) { + $passed -= $skipped; + my $test = 'subtest' . ( $skipped != 1 ? 's' : '' ); + $formatter->_output( + "\n\t(less $skipped skipped $test: $passed okay)"); + } + + if ( my $failed = $parser->todo_passed ) { + my $test = $failed > 1 ? 'tests' : 'test'; + $formatter->_output( + "\n\t($failed TODO $test unexpectedly succeeded)"); + } + + $formatter->_output("\n"); +} + +sub _make_ok_line { + my ( $self, $suffix ) = @_; + return "ok$suffix\n"; +} + +sub time_report { + my ( $self, $formatter, $parser ) = @_; + + my @time_report; + if ( $formatter->timer ) { + my $start_time = $parser->start_time; + my $end_time = $parser->end_time; + if ( defined $start_time and defined $end_time ) { + my $elapsed = $end_time - $start_time; + push @time_report, + $self->time_is_hires + ? sprintf( ' %8d ms', $elapsed * 1000 ) + : sprintf( ' %8s s', $elapsed || '<1' ); + } + my $start_times = $parser->start_times(); + my $end_times = $parser->end_times(); + my $usr = $end_times->[0] - $start_times->[0]; + my $sys = $end_times->[1] - $start_times->[1]; + my $cusr = $end_times->[2] - $start_times->[2]; + my $csys = $end_times->[3] - $start_times->[3]; + push @time_report, + sprintf('(%5.2f usr %5.2f sys + %5.2f cusr %5.2f csys = %5.2f CPU)', + $usr, $sys, $cusr, $csys, + $usr + $sys + $cusr + $csys); + } + + return "@time_report"; +} + +1; diff --git a/lib/TAP/Harness.pm b/lib/TAP/Harness.pm new file mode 100644 index 0000000..a2f6daf --- /dev/null +++ b/lib/TAP/Harness.pm @@ -0,0 +1,1054 @@ +package TAP::Harness; + +use strict; +use warnings; +use Carp; + +use File::Spec; +use File::Path; +use IO::Handle; + +use base 'TAP::Base'; + +=head1 NAME + +TAP::Harness - Run test scripts with statistics + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +$ENV{HARNESS_ACTIVE} = 1; +$ENV{HARNESS_VERSION} = $VERSION; + +END { + + # For VMS. + delete $ENV{HARNESS_ACTIVE}; + delete $ENV{HARNESS_VERSION}; +} + +=head1 DESCRIPTION + +This is a simple test harness which allows tests to be run and results +automatically aggregated and output to STDOUT. + +=head1 SYNOPSIS + + use TAP::Harness; + my $harness = TAP::Harness->new( \%args ); + $harness->runtests(@tests); + +=cut + +my %VALIDATION_FOR; +my @FORMATTER_ARGS; + +sub _error { + my $self = shift; + return $self->{error} unless @_; + $self->{error} = shift; +} + +BEGIN { + + @FORMATTER_ARGS = qw( + directives verbosity timer failures comments errors stdout color + show_count normalize + ); + + %VALIDATION_FOR = ( + lib => sub { + my ( $self, $libs ) = @_; + $libs = [$libs] unless 'ARRAY' eq ref $libs; + + return [ map {"-I$_"} @$libs ]; + }, + switches => sub { shift; shift }, + exec => sub { shift; shift }, + merge => sub { shift; shift }, + aggregator_class => sub { shift; shift }, + formatter_class => sub { shift; shift }, + multiplexer_class => sub { shift; shift }, + parser_class => sub { shift; shift }, + scheduler_class => sub { shift; shift }, + formatter => sub { shift; shift }, + jobs => sub { shift; shift }, + test_args => sub { shift; shift }, + ignore_exit => sub { shift; shift }, + rules => sub { shift; shift }, + rulesfile => sub { shift; shift }, + sources => sub { shift; shift }, + version => sub { shift; shift }, + trap => sub { shift; shift }, + ); + + for my $method ( sort keys %VALIDATION_FOR ) { + no strict 'refs'; + if ( $method eq 'lib' || $method eq 'switches' ) { + *{$method} = sub { + my $self = shift; + unless (@_) { + $self->{$method} ||= []; + return wantarray + ? @{ $self->{$method} } + : $self->{$method}; + } + $self->_croak("Too many arguments to method '$method'") + if @_ > 1; + my $args = shift; + $args = [$args] unless ref $args; + $self->{$method} = $args; + return $self; + }; + } + else { + *{$method} = sub { + my $self = shift; + return $self->{$method} unless @_; + $self->{$method} = shift; + }; + } + } + + for my $method (@FORMATTER_ARGS) { + no strict 'refs'; + *{$method} = sub { + my $self = shift; + return $self->formatter->$method(@_); + }; + } +} + +############################################################################## + +=head1 METHODS + +=head2 Class Methods + +=head3 C + + my %args = ( + verbosity => 1, + lib => [ 'lib', 'blib/lib', 'blib/arch' ], + ) + my $harness = TAP::Harness->new( \%args ); + +The constructor returns a new C object. It accepts an +optional hashref whose allowed keys are: + +=over 4 + +=item * C + +Set the verbosity level: + + 1 verbose Print individual test results to STDOUT. + 0 normal + -1 quiet Suppress some test output (mostly failures + while tests are running). + -2 really quiet Suppress everything but the tests summary. + -3 silent Suppress everything. + +=item * C + +Append run time for each test to output. Uses L if +available. + +=item * C + +Show test failures (this is a no-op if C is selected). + +=item * C + +Show test comments (this is a no-op if C is selected). + +=item * C + +Update the running test count during testing. + +=item * C + +Set to a true value to normalize the TAP that is emitted in verbose modes. + +=item * C + +Accepts a scalar value or array ref of scalar values indicating which +paths to allowed libraries should be included if Perl tests are +executed. Naturally, this only makes sense in the context of tests +written in Perl. + +=item * C + +Accepts a scalar value or array ref of scalar values indicating which +switches should be included if Perl tests are executed. Naturally, this +only makes sense in the context of tests written in Perl. + +=item * C + +A reference to an C<@INC> style array of arguments to be passed to each +test program. + + test_args => ['foo', 'bar'], + +if you want to pass different arguments to each test then you should +pass a hash of arrays, keyed by the alias for each test: + + test_args => { + my_test => ['foo', 'bar'], + other_test => ['baz'], + } + +=item * C + +Attempt to produce color output. + +=item * C + +Typically, Perl tests are run through this. However, anything which +spits out TAP is fine. You can use this argument to specify the name of +the program (and optional switches) to run your tests with: + + exec => ['/usr/bin/ruby', '-w'] + +You can also pass a subroutine reference in order to determine and +return the proper program to run based on a given test script. The +subroutine reference should expect the TAP::Harness object itself as the +first argument, and the file name as the second argument. It should +return an array reference containing the command to be run and including +the test file name. It can also simply return C, in which case +TAP::Harness will fall back on executing the test script in Perl: + + exec => sub { + my ( $harness, $test_file ) = @_; + + # Let Perl tests run. + return undef if $test_file =~ /[.]t$/; + return [ qw( /usr/bin/ruby -w ), $test_file ] + if $test_file =~ /[.]rb$/; + } + +If the subroutine returns a scalar with a newline or a filehandle, it +will be interpreted as raw TAP or as a TAP stream, respectively. + +=item * C + +If C is true the harness will create parsers that merge STDOUT +and STDERR together for any processes they start. + +=item * C + +I. + +If set, C must be a hashref containing the names of the +Ls to load and/or configure. The values are a +hash of configuration that will be accessible to the source handlers via +L. + +For example: + + sources => { + Perl => { exec => '/path/to/custom/perl' }, + File => { extensions => [ '.tap', '.txt' ] }, + MyCustom => { some => 'config' }, + } + +The C parameter affects how C, C and C parameters +are handled. + +For more details, see the C parameter in L, +L, and L. + +=item * C + +The name of the class to use to aggregate test results. The default is +L. + +=item * C + +I. + +Assume this TAP version for L instead of default TAP +version 12. + +=item * C + +The name of the class to use to format output. The default is +L, or L if the output +isn't a TTY. + +=item * C + +The name of the class to use to multiplex tests during parallel testing. +The default is L. + +=item * C + +The name of the class to use to parse TAP. The default is +L. + +=item * C + +The name of the class to use to schedule test execution. The default is +L. + +=item * C + +If set C must be an object that is capable of formatting the +TAP output. See L for an example. + +=item * C + +If parse errors are found in the TAP output, a note of this will be +made in the summary report. To see all of the parse errors, set this +argument to true: + + errors => 1 + +=item * C + +If set to a true value, only test results with directives will be +displayed. This overrides other settings such as C or +C. + +=item * C + +If set to a true value instruct C to ignore exit and wait +status from test scripts. + +=item * C + +The maximum number of parallel tests to run at any time. Which tests +can be run in parallel is controlled by C. The default is to +run only one test at a time. + +=item * C + +A reference to a hash of rules that control which tests may be executed in +parallel. If no rules are declared and L is available, +C attempts to load rules from a YAML file specified by the +C parameter. If no rules file exists, the default is for all +tests to be eligible to be run in parallel. + +Here some simple examples. For the full details of the data structure +and the related glob-style pattern matching, see +L. + + # Run all tests in sequence, except those starting with "p" + $harness->rules({ + par => 't/p*.t' + }); + + # Equivalent YAML file + --- + par: t/p*.t + + # Run all tests in parallel, except those starting with "p" + $harness->rules({ + seq => [ + { seq => 't/p*.t' }, + { par => '**' }, + ], + }); + + # Equivalent YAML file + --- + seq: + - seq: t/p*.t + - par: ** + + # Run some startup tests in sequence, then some parallel tests than some + # teardown tests in sequence. + $harness->rules({ + seq => [ + { seq => 't/startup/*.t' }, + { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], } + { seq => 't/shutdown/*.t' }, + ], + + }); + + # Equivalent YAML file + --- + seq: + - seq: t/startup/*.t + - par: + - t/a/*.t + - t/b/*.t + - t/c/*.t + - seq: t/shutdown/*.t + +This is an experimental feature and the interface may change. + +=item * C + +This specifies where to find a YAML file of test scheduling rules. If not +provided, it looks for a default file to use. It first checks for a file given +in the C environment variable, then it checks for +F and then F. + +=item * C + +A filehandle for catching standard output. + +=item * C + +Attempt to print summary information if run is interrupted by +SIGINT (Ctrl-C). + +=back + +Any keys for which the value is C will be ignored. + +=cut + +# new supplied by TAP::Base + +{ + my @legal_callback = qw( + parser_args + made_parser + before_runtests + after_runtests + after_test + ); + + my %default_class = ( + aggregator_class => 'TAP::Parser::Aggregator', + formatter_class => 'TAP::Formatter::Console', + multiplexer_class => 'TAP::Parser::Multiplexer', + parser_class => 'TAP::Parser', + scheduler_class => 'TAP::Parser::Scheduler', + ); + + sub _initialize { + my ( $self, $arg_for ) = @_; + $arg_for ||= {}; + + $self->SUPER::_initialize( $arg_for, \@legal_callback ); + my %arg_for = %$arg_for; # force a shallow copy + + for my $name ( sort keys %VALIDATION_FOR ) { + my $property = delete $arg_for{$name}; + if ( defined $property ) { + my $validate = $VALIDATION_FOR{$name}; + + my $value = $self->$validate($property); + if ( $self->_error ) { + $self->_croak; + } + $self->$name($value); + } + } + + $self->jobs(1) unless defined $self->jobs; + + if ( ! defined $self->rules ) { + $self->_maybe_load_rulesfile; + } + + local $default_class{formatter_class} = 'TAP::Formatter::File' + unless -t ( $arg_for{stdout} || \*STDOUT ) && !$ENV{HARNESS_NOTTY}; + + while ( my ( $attr, $class ) = each %default_class ) { + $self->$attr( $self->$attr() || $class ); + } + + unless ( $self->formatter ) { + + # This is a little bodge to preserve legacy behaviour. It's + # pretty horrible that we know which args are destined for + # the formatter. + my %formatter_args = ( jobs => $self->jobs ); + for my $name (@FORMATTER_ARGS) { + if ( defined( my $property = delete $arg_for{$name} ) ) { + $formatter_args{$name} = $property; + } + } + + $self->formatter( + $self->_construct( $self->formatter_class, \%formatter_args ) + ); + } + + if ( my @props = sort keys %arg_for ) { + $self->_croak("Unknown arguments to TAP::Harness::new (@props)"); + } + + return $self; + } + + sub _maybe_load_rulesfile { + my ($self) = @_; + + my ($rulesfile) = defined $self->rulesfile ? $self->rulesfile : + defined($ENV{HARNESS_RULESFILE}) ? $ENV{HARNESS_RULESFILE} : + grep { -r } qw(./testrules.yml t/testrules.yml); + + if ( defined $rulesfile && -r $rulesfile ) { + if ( ! eval { require CPAN::Meta::YAML; 1} ) { + warn "CPAN::Meta::YAML required to process $rulesfile" ; + return; + } + my $layer = $] lt "5.008" ? "" : ":encoding(UTF-8)"; + open my $fh, "<$layer", $rulesfile + or die "Couldn't open $rulesfile: $!"; + my $yaml_text = do { local $/; <$fh> }; + my $yaml = CPAN::Meta::YAML->read_string($yaml_text) + or die CPAN::Meta::YAML->errstr; + $self->rules( $yaml->[0] ); + } + return; + } +} + +############################################################################## + +=head2 Instance Methods + +=head3 C + + $harness->runtests(@tests); + +Accepts an array of C<@tests> to be run. This should generally be the +names of test files, but this is not required. Each element in C<@tests> +will be passed to C as a C. See +L for more information. + +It is possible to provide aliases that will be displayed in place of the +test name by supplying the test as a reference to an array containing +C<< [ $test, $alias ] >>: + + $harness->runtests( [ 't/foo.t', 'Foo Once' ], + [ 't/foo.t', 'Foo Twice' ] ); + +Normally it is an error to attempt to run the same test twice. Aliases +allow you to overcome this limitation by giving each run of the test a +unique name. + +Tests will be run in the order found. + +If the environment variable C is defined it +should name a directory into which a copy of the raw TAP for each test +will be written. TAP is written to files named for each test. +Subdirectories will be created as needed. + +Returns a L containing the test results. + +=cut + +sub runtests { + my ( $self, @tests ) = @_; + + my $aggregate = $self->_construct( $self->aggregator_class ); + + $self->_make_callback( 'before_runtests', $aggregate ); + $aggregate->start; + my $finish = sub { + my $interrupted = shift; + $aggregate->stop; + $self->summary( $aggregate, $interrupted ); + $self->_make_callback( 'after_runtests', $aggregate ); + }; + my $run = sub { + $self->aggregate_tests( $aggregate, @tests ); + $finish->(); + }; + + if ( $self->trap ) { + local $SIG{INT} = sub { + print "\n"; + $finish->(1); + exit; + }; + $run->(); + } + else { + $run->(); + } + + return $aggregate; +} + +=head3 C + + $harness->summary( $aggregator ); + +Output the summary for a L. + +=cut + +sub summary { + my ( $self, @args ) = @_; + $self->formatter->summary(@args); +} + +sub _after_test { + my ( $self, $aggregate, $job, $parser ) = @_; + + $self->_make_callback( 'after_test', $job->as_array_ref, $parser ); + $aggregate->add( $job->description, $parser ); +} + +sub _bailout { + my ( $self, $result ) = @_; + my $explanation = $result->explanation; + die "FAILED--Further testing stopped" + . ( $explanation ? ": $explanation\n" : ".\n" ); +} + +sub _aggregate_parallel { + my ( $self, $aggregate, $scheduler ) = @_; + + my $jobs = $self->jobs; + my $mux = $self->_construct( $self->multiplexer_class ); + + RESULT: { + + # Keep multiplexer topped up + FILL: + while ( $mux->parsers < $jobs ) { + my $job = $scheduler->get_job; + + # If we hit a spinner stop filling and start running. + last FILL if !defined $job || $job->is_spinner; + + my ( $parser, $session ) = $self->make_parser($job); + $mux->add( $parser, [ $session, $job ] ); + } + + if ( my ( $parser, $stash, $result ) = $mux->next ) { + my ( $session, $job ) = @$stash; + if ( defined $result ) { + $session->result($result); + $self->_bailout($result) if $result->is_bailout; + } + else { + + # End of parser. Automatically removed from the mux. + $self->finish_parser( $parser, $session ); + $self->_after_test( $aggregate, $job, $parser ); + $job->finish; + } + redo RESULT; + } + } + + return; +} + +sub _aggregate_single { + my ( $self, $aggregate, $scheduler ) = @_; + + JOB: + while ( my $job = $scheduler->get_job ) { + next JOB if $job->is_spinner; + + my ( $parser, $session ) = $self->make_parser($job); + + while ( defined( my $result = $parser->next ) ) { + $session->result($result); + if ( $result->is_bailout ) { + + # Keep reading until input is exhausted in the hope + # of allowing any pending diagnostics to show up. + 1 while $parser->next; + $self->_bailout($result); + } + } + + $self->finish_parser( $parser, $session ); + $self->_after_test( $aggregate, $job, $parser ); + $job->finish; + } + + return; +} + +=head3 C + + $harness->aggregate_tests( $aggregate, @tests ); + +Run the named tests and display a summary of result. Tests will be run +in the order found. + +Test results will be added to the supplied L. +C may be called multiple times to run several sets of +tests. Multiple C instances may be used to pass results +to a single aggregator so that different parts of a complex test suite +may be run using different C settings. This is useful, for +example, in the case where some tests should run in parallel but others +are unsuitable for parallel execution. + + my $formatter = TAP::Formatter::Console->new; + my $ser_harness = TAP::Harness->new( { formatter => $formatter } ); + my $par_harness = TAP::Harness->new( + { formatter => $formatter, + jobs => 9 + } + ); + my $aggregator = TAP::Parser::Aggregator->new; + + $aggregator->start(); + $ser_harness->aggregate_tests( $aggregator, @ser_tests ); + $par_harness->aggregate_tests( $aggregator, @par_tests ); + $aggregator->stop(); + $formatter->summary($aggregator); + +Note that for simpler testing requirements it will often be possible to +replace the above code with a single call to C. + +Each element of the C<@tests> array is either: + +=over + +=item * the source name of a test to run + +=item * a reference to a [ source name, display name ] array + +=back + +In the case of a perl test suite, typically I are simply the file +names of the test scripts to run. + +When you supply a separate display name it becomes possible to run a +test more than once; the display name is effectively the alias by which +the test is known inside the harness. The harness doesn't care if it +runs the same test more than once when each invocation uses a +different name. + +=cut + +sub aggregate_tests { + my ( $self, $aggregate, @tests ) = @_; + + my $jobs = $self->jobs; + my $scheduler = $self->make_scheduler(@tests); + + # #12458 + local $ENV{HARNESS_IS_VERBOSE} = 1 + if $self->formatter->verbosity > 0; + + # Formatter gets only names. + $self->formatter->prepare( map { $_->description } $scheduler->get_all ); + + if ( $self->jobs > 1 ) { + $self->_aggregate_parallel( $aggregate, $scheduler ); + } + else { + $self->_aggregate_single( $aggregate, $scheduler ); + } + + return; +} + +sub _add_descriptions { + my $self = shift; + + # Turn unwrapped scalars into anonymous arrays and copy the name as + # the description for tests that have only a name. + return map { @$_ == 1 ? [ $_->[0], $_->[0] ] : $_ } + map { 'ARRAY' eq ref $_ ? $_ : [$_] } @_; +} + +=head3 C + +Called by the harness when it needs to create a +L. Override in a subclass to provide an +alternative scheduler. C is passed the list of tests +that was passed to C. + +=cut + +sub make_scheduler { + my ( $self, @tests ) = @_; + return $self->_construct( + $self->scheduler_class, + tests => [ $self->_add_descriptions(@tests) ], + rules => $self->rules + ); +} + +=head3 C + +Gets or sets the number of concurrent test runs the harness is +handling. By default, this value is 1 -- for parallel testing, this +should be set higher. + +=cut + +############################################################################## + +sub _get_parser_args { + my ( $self, $job ) = @_; + my $test_prog = $job->filename; + my %args = (); + + $args{sources} = $self->sources if $self->sources; + + my @switches; + @switches = $self->lib if $self->lib; + push @switches => $self->switches if $self->switches; + $args{switches} = \@switches; + $args{spool} = $self->_open_spool($test_prog); + $args{merge} = $self->merge; + $args{ignore_exit} = $self->ignore_exit; + $args{version} = $self->version if $self->version; + + if ( my $exec = $self->exec ) { + $args{exec} + = ref $exec eq 'CODE' + ? $exec->( $self, $test_prog ) + : [ @$exec, $test_prog ]; + if ( not defined $args{exec} ) { + $args{source} = $test_prog; + } + elsif ( ( ref( $args{exec} ) || "" ) ne "ARRAY" ) { + $args{source} = delete $args{exec}; + } + } + else { + $args{source} = $test_prog; + } + + if ( defined( my $test_args = $self->test_args ) ) { + + if ( ref($test_args) eq 'HASH' ) { + + # different args for each test + if ( exists( $test_args->{ $job->description } ) ) { + $test_args = $test_args->{ $job->description }; + } + else { + $self->_croak( "TAP::Harness Can't find test_args for " + . $job->description ); + } + } + + $args{test_args} = $test_args; + } + + return \%args; +} + +=head3 C + +Make a new parser and display formatter session. Typically used and/or +overridden in subclasses. + + my ( $parser, $session ) = $harness->make_parser; + +=cut + +sub make_parser { + my ( $self, $job ) = @_; + + my $args = $self->_get_parser_args($job); + $self->_make_callback( 'parser_args', $args, $job->as_array_ref ); + my $parser = $self->_construct( $self->parser_class, $args ); + + $self->_make_callback( 'made_parser', $parser, $job->as_array_ref ); + my $session = $self->formatter->open_test( $job->description, $parser ); + + return ( $parser, $session ); +} + +=head3 C + +Terminate use of a parser. Typically used and/or overridden in +subclasses. The parser isn't destroyed as a result of this. + +=cut + +sub finish_parser { + my ( $self, $parser, $session ) = @_; + + $session->close_test; + $self->_close_spool($parser); + + return $parser; +} + +sub _open_spool { + my $self = shift; + my $test = shift; + + if ( my $spool_dir = $ENV{PERL_TEST_HARNESS_DUMP_TAP} ) { + + my $spool = File::Spec->catfile( $spool_dir, $test ); + + # Make the directory + my ( $vol, $dir, undef ) = File::Spec->splitpath($spool); + my $path = File::Spec->catpath( $vol, $dir, '' ); + eval { mkpath($path) }; + $self->_croak($@) if $@; + + my $spool_handle = IO::Handle->new; + open( $spool_handle, ">$spool" ) + or $self->_croak(" Can't write $spool ( $! ) "); + + return $spool_handle; + } + + return; +} + +sub _close_spool { + my $self = shift; + my ($parser) = @_; + + if ( my $spool_handle = $parser->delete_spool ) { + close($spool_handle) + or $self->_croak(" Error closing TAP spool file( $! ) \n "); + } + + return; +} + +sub _croak { + my ( $self, $message ) = @_; + unless ($message) { + $message = $self->_error; + } + $self->SUPER::_croak($message); + + return; +} + +1; + +__END__ + +############################################################################## + +=head1 CONFIGURING + +C is designed to be easy to configure. + +=head2 Plugins + +C plugins let you change the way TAP is I to and I +from the parser. + +Ls handle TAP I. You can configure them +and load custom handlers using the C parameter to L. + +Ls handle TAP I. You can load custom formatters by +using the C parameter to L. To configure a formatter, +you currently need to instantiate it outside of L and pass it in +with the C parameter to L. This I be addressed by adding +a I parameter to L in the future. + +=head2 C + +L version C<0.30> supports C. + +To load C plugins, you'll need to use the C +parameter to C, typically from your C. For example: + + Module::Build->new( + module_name => 'MyApp', + test_file_exts => [qw(.t .tap .txt)], + use_tap_harness => 1, + tap_harness_args => { + sources => { + MyCustom => {}, + File => { + extensions => ['.tap', '.txt'], + }, + }, + formatter_class => 'TAP::Formatter::HTML', + }, + build_requires => { + 'Module::Build' => '0.30', + 'TAP::Harness' => '3.18', + }, + )->create_build_script; + +See L + +=head2 C + +L does not support L out-of-the-box. + +=head2 C + +L supports C plugins, and has a plugin system of its +own. See L, L and L +for more details. + +=head1 WRITING PLUGINS + +If you can't configure C to do what you want, and you can't find +an existing plugin, consider writing one. + +The two primary use cases supported by L for plugins are I +and I: + +=over 2 + +=item Customize how TAP gets into the parser + +To do this, you can either extend an existing L, +or write your own. It's a pretty simple API, and they can be loaded and +configured using the C parameter to L. + +=item Customize how TAP results are output from the parser + +To do this, you can either extend an existing L, or write your +own. Writing formatters are a bit more involved than writing a +I, as you'll need to understand the L API. A +good place to start is by understanding how L works. + +Custom formatters can be loaded configured using the C +parameter to L. + +=back + +=head1 SUBCLASSING + +If you can't configure C to do exactly what you want, and writing +a plugin isn't an option, consider extending it. It is designed to be (mostly) +easy to subclass, though the cases when sub-classing is necessary should be few +and far between. + +=head2 Methods + +The following methods are ones you may wish to override if you want to +subclass C. + +=over 4 + +=item L + +=item L + +=item L + +=back + +=cut + +=head1 REPLACING + +If you like the C utility and L but you want your +own harness, all you need to do is write one and provide C and +C methods. Then you can use the C utility like so: + + prove --harness My::Test::Harness + +Note that while C accepts a list of tests (or things to be +tested), C has a fairly rich set of arguments. You'll probably want +to read over this code carefully to see how all of them are being used. + +=head1 SEE ALSO + +L + +=cut + +# vim:ts=4:sw=4:et:sta diff --git a/lib/TAP/Harness/Beyond.pod b/lib/TAP/Harness/Beyond.pod new file mode 100644 index 0000000..989e2ef --- /dev/null +++ b/lib/TAP/Harness/Beyond.pod @@ -0,0 +1,426 @@ +=head1 NAME + +Test::Harness::Beyond - Beyond make test + +=head1 Beyond make test + +Test::Harness is responsible for running test scripts, analysing +their output and reporting success or failure. When I type +F (or F<./Build test>) for a module, Test::Harness is usually +used to run the tests (not all modules use Test::Harness but the +majority do). + +To start exploring some of the features of Test::Harness I need to +switch from F to the F command (which ships with +Test::Harness). For the following examples I'll also need a recent +version of Test::Harness installed; 3.14 is current as I write. + +For the examples I'm going to assume that we're working with a +'normal' Perl module distribution. Specifically I'll assume that +typing F or F<./Build> causes the built, ready-to-install module +code to be available below ./blib/lib and ./blib/arch and that +there's a directory called 't' that contains our tests. Test::Harness +isn't hardwired to that configuration but it saves me from explaining +which files live where for each example. + +Back to F; like F it runs a test suite - but it +provides far more control over which tests are executed, in what +order and how their results are reported. Typically F +runs all the test scripts below the 't' directory. To do the same +thing with prove I type: + + prove -rb t + +The switches here are -r to recurse into any directories below 't' +and -b which adds ./blib/lib and ./blib/arch to Perl's include path +so that the tests can find the code they will be testing. If I'm +testing a module of which an earlier version is already installed +I need to be careful about the include path to make sure I'm not +running my tests against the installed version rather than the new +one that I'm working on. + +Unlike F, typing F doesn't automatically rebuild +my module. If I forget to make before prove I will be testing against +older versions of those files - which inevitably leads to confusion. +I either get into the habit of typing + + make && prove -rb t + +or - if I have no XS code that needs to be built I use the modules +below F instead + + prove -Ilib -r t + +So far I've shown you nothing that F doesn't do. Let's +fix that. + +=head2 Saved State + +If I have failing tests in a test suite that consists of more than +a handful of scripts and takes more than a few seconds to run it +rapidly becomes tedious to run the whole test suite repeatedly as +I track down the problems. + +I can tell prove just to run the tests that are failing like this: + + prove -b t/this_fails.t t/so_does_this.t + +That speeds things up but I have to make a note of which tests are +failing and make sure that I run those tests. Instead I can use +prove's --state switch and have it keep track of failing tests for +me. First I do a complete run of the test suite and tell prove to +save the results: + + prove -rb --state=save t + +That stores a machine readable summary of the test run in a file +called '.prove' in the current directory. If I have failures I can +then run just the failing scripts like this: + + prove -b --state=failed + +I can also tell prove to save the results again so that it updates +its idea of which tests failed: + + prove -b --state=failed,save + +As soon as one of my failing tests passes it will be removed from +the list of failed tests. Eventually I fix them all and prove can +find no failing tests to run: + + Files=0, Tests=0, 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU) + Result: NOTESTS + +As I work on a particular part of my module it's most likely that +the tests that cover that code will fail. I'd like to run the whole +test suite but have it prioritize these 'hot' tests. I can tell +prove to do this: + + prove -rb --state=hot,save t + +All the tests will run but those that failed most recently will be +run first. If no tests have failed since I started saving state all +tests will run in their normal order. This combines full test +coverage with early notification of failures. + +The --state switch supports a number of options; for example to run +failed tests first followed by all remaining tests ordered by the +timestamps of the test scripts - and save the results - I can use + + prove -rb --state=failed,new,save t + +See the prove documentation (type prove --man) for the full list +of state options. + +When I tell prove to save state it writes a file called '.prove' +('_prove' on Windows) in the current directory. It's a YAML document +so it's quite easy to write tools of your own that work on the saved +test state - but the format isn't officially documented so it might +change without (much) warning in the future. + +=head2 Parallel Testing + +If my tests take too long to run I may be able to speed them up by +running multiple test scripts in parallel. This is particularly +effective if the tests are I/O bound or if I have multiple CPU +cores. I tell prove to run my tests in parallel like this: + + prove -rb -j 9 t + +The -j switch enables parallel testing; the number that follows it +is the maximum number of tests to run in parallel. Sometimes tests +that pass when run sequentially will fail when run in parallel. For +example if two different test scripts use the same temporary file +or attempt to listen on the same socket I'll have problems running +them in parallel. If I see unexpected failures I need to check my +tests to work out which of them are trampling on the same resource +and rename temporary files or add locks as appropriate. + +To get the most performance benefit I want to have the test scripts +that take the longest to run start first - otherwise I'll be waiting +for the one test that takes nearly a minute to complete after all +the others are done. I can use the --state switch to run the tests +in slowest to fastest order: + + prove -rb -j 9 --state=slow,save t + +=head2 Non-Perl Tests + +The Test Anything Protocol (http://testanything.org/) isn't just +for Perl. Just about any language can be used to write tests that +output TAP. There are TAP based testing libraries for C, C++, PHP, +Python and many others. If I can't find a TAP library for my language +of choice it's easy to generate valid TAP. It looks like this: + + 1..3 + ok 1 - init OK + ok 2 - opened file + not ok 3 - appended to file + +The first line is the plan - it specifies the number of tests I'm +going to run so that it's easy to check that the test script didn't +exit before running all the expected tests. The following lines are +the test results - 'ok' for pass, 'not ok' for fail. Each test has +a number and, optionally, a description. And that's it. Any language +that can produce output like that on STDOUT can be used to write +tests. + +Recently I've been rekindling a two-decades-old interest in Forth. +Evidently I have a masochistic streak that even Perl can't satisfy. +I want to write tests in Forth and run them using prove (you can +find my gforth TAP experiments at +https://svn.hexten.net/andy/Forth/Testing/). I can use the --exec +switch to tell prove to run the tests using gforth like this: + + prove -r --exec gforth t + +Alternately, if the language used to write my tests allows a shebang +line I can use that to specify the interpreter. Here's a test written +in PHP: + + #!/usr/bin/php + + +If I save that as t/phptest.t the shebang line will ensure that it +runs correctly along with all my other tests. + +=head2 Mixing it up + +Subtle interdependencies between test programs can mask problems - +for example an earlier test may neglect to remove a temporary file +that affects the behaviour of a later test. To find this kind of +problem I use the --shuffle and --reverse options to run my tests +in random or reversed order. + +=head2 Rolling My Own + +If I need a feature that prove doesn't provide I can easily write my own. + +Typically you'll want to change how TAP gets I into and I +from the parser. L supports arbitrary plugins, and L +supports custom I and I that you can load using +either L or L; there are many examples to base mine on. +For more details see L, L, and +L. + +If writing a plugin is not enough, you can write your own test harness; one of +the motives for the 3.00 rewrite of Test::Harness was to make it easier to +subclass and extend. + +The Test::Harness module is a compatibility wrapper around TAP::Harness. +For new applications I should use TAP::Harness directly. As we'll +see, prove uses TAP::Harness. + +When I run prove it processes its arguments, figures out which test +scripts to run and then passes control to TAP::Harness to run the +tests, parse, analyse and present the results. By subclassing +TAP::Harness I can customise many aspects of the test run. + +I want to log my test results in a database so I can track them +over time. To do this I override the summary method in TAP::Harness. +I start with a simple prototype that dumps the results as a YAML +document: + + package My::TAP::Harness; + + use base 'TAP::Harness'; + use YAML; + + sub summary { + my ( $self, $aggregate ) = @_; + print Dump( $aggregate ); + $self->SUPER::summary( $aggregate ); + } + + 1; + +I need to tell prove to use my My::TAP::Harness. If My::TAP::Harness +is on Perl's @INC include path I can + + prove --harness=My::TAP::Harness -rb t + +If I don't have My::TAP::Harness installed on @INC I need to provide +the correct path to perl when I run prove: + + perl -Ilib `which prove` --harness=My::TAP::Harness -rb t + +I can incorporate these options into my own version of prove. It's +pretty simple. Most of the work of prove is handled by App::Prove. +The important code in prove is just: + + use App::Prove; + + my $app = App::Prove->new; + $app->process_args(@ARGV); + exit( $app->run ? 0 : 1 ); + +If I write a subclass of App::Prove I can customise any aspect of +the test runner while inheriting all of prove's behaviour. Here's +myprove: + + #!/usr/bin/env perl use lib qw( lib ); # Add ./lib to @INC + use App::Prove; + + my $app = App::Prove->new; + + # Use custom TAP::Harness subclass + $app->harness( 'My::TAP::Harness' ); + + $app->process_args( @ARGV ); exit( $app->run ? 0 : 1 ); + +Now I can run my tests like this + + ./myprove -rb t + +=head2 Deeper Customisation + +Now that I know how to subclass and replace TAP::Harness I can +replace any other part of the harness. To do that I need to know +which classes are responsible for which functionality. Here's a +brief guided tour; the default class for each component is shown +in parentheses. Normally any replacements I write will be subclasses +of these default classes. + +When I run my tests TAP::Harness creates a scheduler +(TAP::Parser::Scheduler) to work out the running order for the +tests, an aggregator (TAP::Parser::Aggregator) to collect and analyse +the test results and a formatter (TAP::Formatter::Console) to display +those results. + +If I'm running my tests in parallel there may also be a multiplexer +(TAP::Parser::Multiplexer) - the component that allows multiple +tests to run simultaneously. + +Once it has created those helpers TAP::Harness starts running the +tests. For each test it creates a new parser (TAP::Parser) which +is responsible for running the test script and parsing its output. + +To replace any of these components I call one of these harness +methods with the name of the replacement class: + + aggregator_class + formatter_class + multiplexer_class + parser_class + scheduler_class + +For example, to replace the aggregator I would + + $harness->aggregator_class( 'My::Aggregator' ); + +Alternately I can supply the names of my substitute classes to the +TAP::Harness constructor: + + my $harness = TAP::Harness->new( + { aggregator_class => 'My::Aggregator' } + ); + +If I need to reach even deeper into the internals of the harness I +can replace the classes that TAP::Parser uses to execute test scripts +and tokenise their output. Before running a test script TAP::Parser +creates a grammar (TAP::Parser::Grammar) to decode the raw TAP into +tokens, a result factory (TAP::Parser::ResultFactory) to turn the +decoded TAP results into objects and, depending on whether it's +running a test script or reading TAP from a file, scalar or array +a source or an iterator (TAP::Parser::IteratorFactory). + +Each of these objects may be replaced by calling one of these parser +methods: + + source_class + perl_source_class + grammar_class + iterator_factory_class + result_factory_class + +=head2 Callbacks + +As an alternative to subclassing the components I need to change I +can attach callbacks to the default classes. TAP::Harness exposes +these callbacks: + + parser_args Tweak the parameters used to create the parser + made_parser Just made a new parser + before_runtests About to run tests + after_runtests Have run all tests + after_test Have run an individual test script + +TAP::Parser also supports callbacks; bailout, comment, plan, test, +unknown, version and yaml are called for the corresponding TAP +result types, ALL is called for all results, ELSE is called for all +results for which a named callback is not installed and EOF is +called once at the end of each TAP stream. + +To install a callback I pass the name of the callback and a subroutine +reference to TAP::Harness or TAP::Parser's callback method: + + $harness->callback( after_test => sub { + my ( $script, $desc, $parser ) = @_; + } ); + +I can also pass callbacks to the constructor: + + my $harness = TAP::Harness->new({ + callbacks => { + after_test => sub { + my ( $script, $desc, $parser ) = @_; + # Do something interesting here + } + } + }); + +When it comes to altering the behaviour of the test harness there's +more than one way to do it. Which way is best depends on my +requirements. In general if I only want to observe test execution +without changing the harness' behaviour (for example to log test +results to a database) I choose callbacks. If I want to make the +harness behave differently subclassing gives me more control. + +=head2 Parsing TAP + +Perhaps I don't need a complete test harness. If I already have a +TAP test log that I need to parse all I need is TAP::Parser and the +various classes it depends upon. Here's the code I need to run a +test and parse its TAP output + + use TAP::Parser; + + my $parser = TAP::Parser->new( { source => 't/simple.t' } ); + while ( my $result = $parser->next ) { + print $result->as_string, "\n"; + } + +Alternately I can pass an open filehandle as source and have the +parser read from that rather than attempting to run a test script: + + open my $tap, '<', 'tests.tap' + or die "Can't read TAP transcript ($!)\n"; + my $parser = TAP::Parser->new( { source => $tap } ); + while ( my $result = $parser->next ) { + print $result->as_string, "\n"; + } + +This approach is useful if I need to convert my TAP based test +results into some other representation. See TAP::Convert::TET +(http://search.cpan.org/dist/TAP-Convert-TET/) for an example of +this approach. + +=head2 Getting Support + +The Test::Harness developers hang out on the tapx-dev mailing +list[1]. For discussion of general, language independent TAP issues +there's the tap-l[2] list. Finally there's a wiki dedicated to the +Test Anything Protocol[3]. Contributions to the wiki, patches and +suggestions are all welcome. + +=for comment + The URLs in [1] and [2] point to 404 pages. What are currently the + correct URLs? + +[1] L +[2] L +[3] L diff --git a/lib/TAP/Harness/Env.pm b/lib/TAP/Harness/Env.pm new file mode 100644 index 0000000..077626d --- /dev/null +++ b/lib/TAP/Harness/Env.pm @@ -0,0 +1,215 @@ +package TAP::Harness::Env; + +use strict; +use warnings; + +use constant IS_VMS => ( $^O eq 'VMS' ); +use TAP::Object; +use Text::ParseWords qw/shellwords/; + +our $VERSION = '3.42'; + +# Get the parts of @INC which are changed from the stock list AND +# preserve reordering of stock directories. +sub _filtered_inc_vms { + my @inc = grep { !ref } @INC; #28567 + + # 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; + + my @default_inc = _default_inc(); + + my @new_inc; + my %seen; + for my $dir (@inc) { + next if $seen{$dir}++; + + if ( $dir eq ( $default_inc[0] || '' ) ) { + shift @default_inc; + } + else { + push @new_inc, $dir; + } + + shift @default_inc while @default_inc and $seen{ $default_inc[0] }; + } + return @new_inc; +} + +# Cache this to avoid repeatedly shelling out to Perl. +my @inc; + +sub _default_inc { + return @inc if @inc; + + local $ENV{PERL5LIB}; + local $ENV{PERLLIB}; + + my $perl = $ENV{HARNESS_PERL} || $^X; + + # Avoid using -l for the benefit of Perl 6 + chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` ); + return @inc; +} + +sub create { + my $package = shift; + my %input = %{ shift || {} }; + + my @libs = @{ delete $input{libs} || [] }; + my @raw_switches = @{ delete $input{switches} || [] }; + my @opt + = ( @raw_switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} || '' ) ); + my @switches; + while ( my $opt = shift @opt ) { + if ( $opt =~ /^ -I (.*) $ /x ) { + push @libs, length($1) ? $1 : shift @opt; + } + else { + push @switches, $opt; + } + } + + # Do things the old way on VMS... + push @libs, _filtered_inc_vms() if IS_VMS; + + # If $Verbose isn't numeric default to 1. This helps core. + my $verbose + = $ENV{HARNESS_VERBOSE} + ? $ENV{HARNESS_VERBOSE} !~ /\d/ + ? 1 + : $ENV{HARNESS_VERBOSE} + : 0; + + my %args = ( + lib => \@libs, + timer => $ENV{HARNESS_TIMER} || 0, + switches => \@switches, + color => $ENV{HARNESS_COLOR} || 0, + verbosity => $verbose, + ignore_exit => $ENV{HARNESS_IGNORE_EXIT} || 0, + ); + + my $class = delete $input{harness_class} || $ENV{HARNESS_SUBCLASS} || 'TAP::Harness'; + if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) { + for my $opt ( split /:/, $env_opt ) { + if ( $opt =~ /^j(\d*)$/ ) { + $args{jobs} = $1 || 9; + } + elsif ( $opt eq 'c' ) { + $args{color} = 1; + } + elsif ( $opt =~ m/^f(.*)$/ ) { + my $fmt = $1; + $fmt =~ s/-/::/g; + $args{formatter_class} = $fmt; + } + elsif ( $opt =~ m/^a(.*)$/ ) { + my $archive = $1; + $class = 'TAP::Harness::Archive'; + $args{archive} = $archive; + } + else { + die "Unknown HARNESS_OPTIONS item: $opt\n"; + } + } + } + return TAP::Object->_construct($class, { %args, %input }); +} + +1; + +=head1 NAME + +TAP::Harness::Env - Parsing harness related environmental variables where appropriate + +=head1 VERSION + +Version 3.42 + +=head1 SYNOPSIS + + my $harness = TAP::Harness::Env->create(\%extra_args) + +=head1 DESCRIPTION + +This module implements the environmental variables that L uses with TAP::Harness, and instantiates the appropriate class with the appropriate arguments. + +=head1 METHODS + +=over 4 + +=item * create( \%args ) + +This function reads the environment and generates an appropriate argument hash from it. If given any arguments in C<%extra_args>, these will override the environmental defaults. In accepts C (which defaults to C), and any argument the harness class accepts. + +=back + +=head1 ENVIRONMENTAL VARIABLES + +=over 4 + +=item C + +Setting this adds perl command line switches to each test file run. + +For example, C will turn on taint mode. +C will run C for +each test. + +=item C + +If true, C will output the verbose results of running +its tests. + +=item C + +Specifies a TAP::Harness subclass to be used in place of TAP::Harness. + +=item C + +Provide additional options to the harness. Currently supported options are: + +=over + +=item C<< j >> + +Run (default 9) parallel jobs. + +=item C<< c >> + +Try to color output. See L. + +=item C<< a >> + +Will use L as the harness class, and save the TAP to +C + +=item C<< fPackage-With-Dashes >> + +Set the formatter_class of the harness being run. Since the C +is seperated by C<:>, we use C<-> instead. + +=back + +Multiple options may be separated by colons: + + HARNESS_OPTIONS=j9:c make test + +=item C + +Setting this to true will make the harness display the number of +milliseconds each test took. You can also use F's C<--timer> +switch. + +=item C + +Attempt to produce color output. + +=item C + +If set to a true value instruct C to ignore exit and wait +status from test scripts. + +=back diff --git a/lib/TAP/Object.pm b/lib/TAP/Object.pm new file mode 100644 index 0000000..e9da17f --- /dev/null +++ b/lib/TAP/Object.pm @@ -0,0 +1,155 @@ +package TAP::Object; + +use strict; +use warnings; + +=head1 NAME + +TAP::Object - Base class that provides common functionality to all C modules + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +=head1 SYNOPSIS + + package TAP::Whatever; + + use strict; + + use base 'TAP::Object'; + + # new() implementation by TAP::Object + sub _initialize { + my ( $self, @args) = @_; + # initialize your object + return $self; + } + + # ... later ... + my $obj = TAP::Whatever->new(@args); + +=head1 DESCRIPTION + +C provides a default constructor and exception model for all +C classes. Exceptions are raised using L. + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +Create a new object. Any arguments passed to C will be passed on to the +L method. Returns a new object. + +=cut + +sub new { + my $class = shift; + my $self = bless {}, $class; + return $self->_initialize(@_); +} + +=head2 Instance Methods + +=head3 C<_initialize> + +Initializes a new object. This method is a stub by default, you should override +it as appropriate. + +I L expects you to return C<$self> or raise an exception. See +L, and L. + +=cut + +sub _initialize { + return $_[0]; +} + +=head3 C<_croak> + +Raise an exception using C from L, eg: + + $self->_croak( 'why me?', 'aaarrgh!' ); + +May also be called as a I method. + + $class->_croak( 'this works too' ); + +=cut + +sub _croak { + my $proto = shift; + require Carp; + Carp::croak(@_); + return; +} + +=head3 C<_confess> + +Raise an exception using C from L, eg: + + $self->_confess( 'why me?', 'aaarrgh!' ); + +May also be called as a I method. + + $class->_confess( 'this works too' ); + +=cut + +sub _confess { + my $proto = shift; + require Carp; + Carp::confess(@_); + return; +} + +=head3 C<_construct> + +Create a new instance of the specified class. + +=cut + +sub _construct { + my ( $self, $class, @args ) = @_; + + $self->_croak("Bad module name $class") + unless $class =~ /^ \w+ (?: :: \w+ ) *$/x; + + unless ( $class->can('new') ) { + local $@; + eval "require $class"; + $self->_croak("Can't load $class: $@") if $@; + } + + return $class->new(@args); +} + +=head3 C + +Create simple getter/setters. + + __PACKAGE__->mk_methods(@method_names); + +=cut + +sub mk_methods { + my ( $class, @methods ) = @_; + for my $method_name (@methods) { + my $method = "${class}::$method_name"; + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method_name} = shift if @_; + return $self->{$method_name}; + }; + } +} + +1; + diff --git a/lib/TAP/Parser.pm b/lib/TAP/Parser.pm new file mode 100644 index 0000000..34f4110 --- /dev/null +++ b/lib/TAP/Parser.pm @@ -0,0 +1,1931 @@ +package TAP::Parser; + +use strict; +use warnings; + +use TAP::Parser::Grammar (); +use TAP::Parser::Result (); +use TAP::Parser::ResultFactory (); +use TAP::Parser::Source (); +use TAP::Parser::Iterator (); +use TAP::Parser::IteratorFactory (); +use TAP::Parser::SourceHandler::Executable (); +use TAP::Parser::SourceHandler::Perl (); +use TAP::Parser::SourceHandler::File (); +use TAP::Parser::SourceHandler::RawTAP (); +use TAP::Parser::SourceHandler::Handle (); + +use Carp qw( confess ); + +use base 'TAP::Base'; + +=encoding utf8 + +=head1 NAME + +TAP::Parser - Parse L output + +=head1 VERSION + +Version 3.42 + +=cut + +our $VERSION = '3.42'; + +my $DEFAULT_TAP_VERSION = 12; +my $MAX_TAP_VERSION = 13; + +$ENV{TAP_VERSION} = $MAX_TAP_VERSION; + +END { + + # For VMS. + delete $ENV{TAP_VERSION}; +} + +BEGIN { # making accessors + __PACKAGE__->mk_methods( + qw( + _iterator + _spool + exec + exit + is_good_plan + plan + tests_planned + tests_run + wait + version + in_todo + start_time + end_time + start_times + end_times + skip_all + grammar_class + result_factory_class + iterator_factory_class + ) + ); + + sub _stream { # deprecated + my $self = shift; + $self->_iterator(@_); + } +} # done making accessors + +=head1 SYNOPSIS + + use TAP::Parser; + + my $parser = TAP::Parser->new( { source => $source } ); + + while ( my $result = $parser->next ) { + print $result->as_string; + } + +=head1 DESCRIPTION + +C is designed to produce a proper parse of TAP output. For +an example of how to run tests through this module, see the simple +harnesses C. + +There's a wiki dedicated to the Test Anything Protocol: + +L + +It includes the TAP::Parser Cookbook: + +L + +=head1 METHODS + +=head2 Class Methods + +=head3 C + + my $parser = TAP::Parser->new(\%args); + +Returns a new C object. + +The arguments should be a hashref with I of the following keys: + +=over 4 + +=item * C + +I + +This is the preferred method of passing input to the constructor. + +The C is used to create a L that is passed to the +L which in turn figures out how to handle the source and +creates a for it. The iterator is used by the parser to +read in the TAP stream. + +To configure the I use the C parameter below. + +Note that C, C and C are I. + +=item * C + +I + +The value should be the complete TAP output. + +The I is used to create a L that is passed to the +L which in turn figures out how to handle the source and +creates a for it. The iterator is used by the parser to +read in the TAP stream. + +To configure the I use the C parameter below. + +Note that C, C and C are I. + +=item * C + +Must be passed an array reference. + +The I array ref is used to create a L that is passed +to the L which in turn figures out how to handle the +source and creates a for it. The iterator is used by +the parser to read in the TAP stream. + +By default the L class will create a +L object to handle the source. This passes the +array reference strings as command arguments to L: + + exec => [ '/usr/bin/ruby', 't/my_test.rb' ] + +If any C are given they will be appended to the end of the command +argument list. + +To configure the I use the C parameter below. + +Note that C, C and C are I. + +=back + +The following keys are optional. + +=over 4 + +=item * C + +I. + +If set, C must be a hashref containing the names of the +Ls to load and/or configure. The values are a +hash of configuration that will be accessible to the source handlers via +L. + +For example: + + sources => { + Perl => { exec => '/path/to/custom/perl' }, + File => { extensions => [ '.tap', '.txt' ] }, + MyCustom => { some => 'config' }, + } + +This will cause C to pass custom configuration to two of the built- +in source handlers - L, +L - and attempt to load the C +class. See L for more detail. + +The C parameter affects how C, C and C parameters +are handled. + +See L, L and subclasses for +more details. + +=item * C + +If present, each callback corresponding to a given result type will be called +with the result as the argument if the C method is used: + + my %callbacks = ( + test => \&test_callback, + plan => \&plan_callback, + comment => \&comment_callback, + bailout => \&bailout_callback, + unknown => \&unknown_callback, + ); + + my $aggregator = TAP::Parser::Aggregator->new; + for my $file ( @test_files ) { + my $parser = TAP::Parser->new( + { + source => $file, + callbacks => \%callbacks, + } + ); + $parser->run; + $aggregator->add( $file, $parser ); + } + +=item * C + +If using a Perl file as a source, optional switches may be passed which will +be used when invoking the perl executable. + + my $parser = TAP::Parser->new( { + source => $test_file, + switches => [ '-Ilib' ], + } ); + +=item * C + +Used in conjunction with the C and C option to supply a reference +to an C<@ARGV> style array of arguments to pass to the test program. + +=item * C + +If passed a filehandle will write a copy of all parsed TAP to that handle. + +=item * C + +If false, STDERR is not captured (though it is 'relayed' to keep it +somewhat synchronized with STDOUT.) + +If true, STDERR and STDOUT are the same filehandle. This may cause +breakage if STDERR contains anything resembling TAP format, but does +allow exact synchronization. + +Subtleties of this behavior may be platform-dependent and may change in +the future. + +=item * C + +This option was introduced to let you easily customize which I class +the parser should use. It defaults to L. + +See also L. + +=item * C + +This option was introduced to let you easily customize which I +factory class the parser should use. It defaults to +L. + +See also L. + +=item * C + +I + +This option was introduced to let you easily customize which I +factory class the parser should use. It defaults to +L. + +=back + +=cut + +# new() implementation supplied by TAP::Base + +# This should make overriding behaviour of the Parser in subclasses easier: +sub _default_grammar_class {'TAP::Parser::Grammar'} +sub _default_result_factory_class {'TAP::Parser::ResultFactory'} +sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'} + +############################################################################## + +=head2 Instance Methods + +=head3 C + + my $parser = TAP::Parser->new( { source => $file } ); + while ( my $result = $parser->next ) { + print $result->as_string, "\n"; + } + +This method returns the results of the parsing, one result at a time. Note +that it is destructive. You can't rewind and examine previous results. + +If callbacks are used, they will be issued before this call returns. + +Each result returned is a subclass of L. See that +module and related classes for more information on how to use them. + +=cut + +sub next { + my $self = shift; + return ( $self->{_iter} ||= $self->_iter )->(); +} + +############################################################################## + +=head3 C + + $parser->run; + +This method merely runs the parser and parses all of the TAP. + +=cut + +sub run { + my $self = shift; + while ( defined( my $result = $self->next ) ) { + + # do nothing + } +} + +############################################################################## + +=head3 C + +Make a new L object and return it. Passes through any +arguments given. + +The C can be customized, as described in L. + +=head3 C + +Make a new L object using the parser's +L, and return it. Passes through any arguments +given. + +The C can be customized, as described in L. + +=head3 C + +I. + +Make a new L object and return it. Passes through +any arguments given. + +C can be customized, as described in L. + +=cut + +# This should make overriding behaviour of the Parser in subclasses easier: +sub make_iterator_factory { shift->iterator_factory_class->new(@_); } +sub make_grammar { shift->grammar_class->new(@_); } +sub make_result { shift->result_factory_class->make_result(@_); } + +{ + + # of the following, anything beginning with an underscore is strictly + # internal and should not be exposed. + my %initialize = ( + version => $DEFAULT_TAP_VERSION, + plan => '', # the test plan (e.g., 1..3) + tests_run => 0, # actual current test numbers + skipped => [], # + todo => [], # + passed => [], # + failed => [], # + actual_failed => [], # how many tests really failed + actual_passed => [], # how many tests really passed + todo_passed => [], # tests which unexpectedly succeed + parse_errors => [], # perfect TAP should have none + ); + + # We seem to have this list hanging around all over the place. We could + # probably get it from somewhere else to avoid the repetition. + my @legal_callback = qw( + test + version + plan + comment + bailout + unknown + yaml + ALL + ELSE + EOF + ); + + my @class_overrides = qw( + grammar_class + result_factory_class + iterator_factory_class + ); + + sub _initialize { + my ( $self, $arg_for ) = @_; + + # everything here is basically designed to convert any TAP source to a + # TAP::Parser::Iterator. + + # Shallow copy + my %args = %{ $arg_for || {} }; + + $self->SUPER::_initialize( \%args, \@legal_callback ); + + # get any class overrides out first: + for my $key (@class_overrides) { + my $default_method = "_default_$key"; + my $val = delete $args{$key} || $self->$default_method(); + $self->$key($val); + } + + my $iterator = delete $args{iterator}; + $iterator ||= delete $args{stream}; # deprecated + my $tap = delete $args{tap}; + my $version = delete $args{version}; + my $raw_source = delete $args{source}; + my $sources = delete $args{sources}; + my $exec = delete $args{exec}; + my $merge = delete $args{merge}; + my $spool = delete $args{spool}; + my $switches = delete $args{switches}; + my $ignore_exit = delete $args{ignore_exit}; + my $test_args = delete $args{test_args} || []; + + if ( 1 < grep {defined} $iterator, $tap, $raw_source, $exec ) { + $self->_croak( + "You may only choose one of 'exec', 'tap', 'source' or 'iterator'" + ); + } + + if ( my @excess = sort keys %args ) { + $self->_croak("Unknown options: @excess"); + } + + # convert $tap & $exec to $raw_source equiv. + my $type = ''; + my $source = TAP::Parser::Source->new; + if ($tap) { + $type = 'raw TAP'; + $source->raw( \$tap ); + } + elsif ($exec) { + $type = 'exec ' . $exec->[0]; + $source->raw( { exec => $exec } ); + } + elsif ($raw_source) { + $type = 'source ' . ref($raw_source) || $raw_source; + $source->raw( ref($raw_source) ? $raw_source : \$raw_source ); + } + elsif ($iterator) { + $type = 'iterator ' . ref($iterator); + } + + if ( $source->raw ) { + my $src_factory = $self->make_iterator_factory($sources); + $source->merge($merge)->switches($switches) + ->test_args($test_args); + $iterator = $src_factory->make_iterator($source); + } + + unless ($iterator) { + $self->_croak( + "PANIC: could not determine iterator for input $type"); + } + + while ( my ( $k, $v ) = each %initialize ) { + $self->{$k} = 'ARRAY' eq ref $v ? [] : $v; + } + + $self->version($version) if $version; + $self->_iterator($iterator); + $self->_spool($spool); + $self->ignore_exit($ignore_exit); + + return $self; + } +} + +=head1 INDIVIDUAL RESULTS + +If you've read this far in the docs, you've seen this: + + while ( my $result = $parser->next ) { + print $result->as_string; + } + +Each result returned is a L subclass, referred to as +I. + +=head2 Result types + +Basically, you fetch individual results from the TAP. The six types, with +examples of each, are as follows: + +=over 4 + +=item * Version + + TAP version 12 + +=item * Plan + + 1..42 + +=item * Pragma + + pragma +strict + +=item * Test + + ok 3 - We should start with some foobar! + +=item * Comment + + # Hope we don't use up the foobar. + +=item * Bailout + + Bail out! We ran out of foobar! + +=item * Unknown + + ... yo, this ain't TAP! ... + +=back + +Each result fetched is a result object of a different type. There are common +methods to each result object and different types may have methods unique to +their type. Sometimes a type method may be overridden in a subclass, but its +use is guaranteed to be identical. + +=head2 Common type methods + +=head3 C + +Returns the type of result, such as C or C. + +=head3 C + +Prints a string representation of the token. This might not be the exact +output, however. Tests will have test numbers added if not present, TODO and +SKIP directives will be capitalized and, in general, things will be cleaned +up. If you need the original text for the token, see the C method. + +=head3 C + +Returns the original line of text which was parsed. + +=head3 C + +Indicates whether or not this is the test plan line. + +=head3 C + +Indicates whether or not this is a test line. + +=head3 C + +Indicates whether or not this is a comment. Comments will generally only +appear in the TAP stream if STDERR is merged to STDOUT. See the +C option. + +=head3 C + +Indicates whether or not this is bailout line. + +=head3 C + +Indicates whether or not the current item is a YAML block. + +=head3 C + +Indicates whether or not the current line could be parsed. + +=head3 C + + if ( $result->is_ok ) { ... } + +Reports whether or not a given result has passed. Anything which is B a +test result returns true. This is merely provided as a convenient shortcut +which allows you to do this: + + my $parser = TAP::Parser->new( { source => $source } ); + while ( my $result = $parser->next ) { + # only print failing results + print $result->as_string unless $result->is_ok; + } + +=head2 C methods + + if ( $result->is_plan ) { ... } + +If the above evaluates as true, the following methods will be available on the +C<$result> object. + +=head3 C + + if ( $result->is_plan ) { + print $result->plan; + } + +This is merely a synonym for C. + +=head3 C + + my $directive = $result->directive; + +If a SKIP directive is included with the plan, this method will return it. + + 1..0 # SKIP: why bother? + +=head3 C + + my $explanation = $result->explanation; + +If a SKIP directive was included with the plan, this method will return the +explanation, if any. + +=head2 C methods + + if ( $result->is_pragma ) { ... } + +If the above evaluates as true, the following methods will be available on the +C<$result> object. + +=head3 C + +Returns a list of pragmas each of which is a + or - followed by the +pragma name. + +=head2 C methods + + if ( $result->is_comment ) { ... } + +If the above evaluates as true, the following methods will be available on the +C<$result> object. + +=head3 C + + if ( $result->is_comment ) { + my $comment = $result->comment; + print "I have something to say: $comment"; + } + +=head2 C methods + + if ( $result->is_bailout ) { ... } + +If the above evaluates as true, the following methods will be available on the +C<$result> object. + +=head3 C + + if ( $result->is_bailout ) { + my $explanation = $result->explanation; + print "We bailed out because ($explanation)"; + } + +If, and only if, a token is a bailout token, you can get an "explanation" via +this method. The explanation is the text after the mystical "Bail out!" words +which appear in the tap output. + +=head2 C methods + + if ( $result->is_unknown ) { ... } + +There are no unique methods for unknown results. + +=head2 C methods + + if ( $result->is_test ) { ... } + +If the above evaluates as true, the following methods will be available on the +C<$result> object. + +=head3 C + + my $ok = $result->ok; + +Returns the literal text of the C or C status. + +=head3 C + + my $test_number = $result->number; + +Returns the number of the test, even if the original TAP output did not supply +that number. + +=head3 C + + my $description = $result->description; + +Returns the description of the test, if any. This is the portion after the +test number but before the directive. + +=head3 C + + my $directive = $result->directive; + +Returns either C or C if either directive was present for a test +line. + +=head3 C + + my $explanation = $result->explanation; + +If a test had either a C or C directive, this method will return +the accompanying explanation, if present. + + not ok 17 - 'Pigs can fly' # TODO not enough acid + +For the above line, the explanation is I. + +=head3 C + + if ( $result->is_ok ) { ... } + +Returns a boolean value indicating whether or not the test passed. Remember +that for TODO tests, the test always passes. + +B this was formerly C. The latter method is deprecated and +will issue a warning. + +=head3 C + + if ( $result->is_actual_ok ) { ... } + +Returns a boolean value indicating whether or not the test passed, regardless +of its TODO status. + +B this was formerly C. The latter method is deprecated +and will issue a warning. + +=head3 C + + if ( $test->is_unplanned ) { ... } + +If a test number is greater than the number of planned tests, this method will +return true. Unplanned tests will I return false for C, +regardless of whether or not the test C (see +L for more information about this). + +=head3 C + + if ( $result->has_skip ) { ... } + +Returns a boolean value indicating whether or not this test had a SKIP +directive. + +=head3 C + + if ( $result->has_todo ) { ... } + +Returns a boolean value indicating whether or not this test had a TODO +directive. + +Note that TODO tests I pass. If you need to know whether or not +they really passed, check the C method. + +=head3 C + + if ( $parser->in_todo ) { ... } + +True while the most recent result was a TODO. Becomes true before the +TODO result is returned and stays true until just before the next non- +TODO test is returned. + +=head1 TOTAL RESULTS + +After parsing the TAP, there are many methods available to let you dig through +the results and determine what is meaningful to you. + +=head2 Individual Results + +These results refer to individual tests which are run. + +=head3 C + + my @passed = $parser->passed; # the test numbers which passed + my $passed = $parser->passed; # the number of tests which passed + +This method lets you know which (or how many) tests passed. If a test failed +but had a TODO directive, it will be counted as a passed test. + +=cut + +sub passed { + return @{ $_[0]->{passed} } + if ref $_[0]->{passed}; + return wantarray ? 1 .. $_[0]->{passed} : $_[0]->{passed}; +} + +=head3 C + + my @failed = $parser->failed; # the test numbers which failed + my $failed = $parser->failed; # the number of tests which failed + +This method lets you know which (or how many) tests failed. If a test passed +but had a TODO directive, it will B be counted as a failed test. + +=cut + +sub failed { @{ shift->{failed} } } + +=head3 C + + # the test numbers which actually passed + my @actual_passed = $parser->actual_passed; + + # the number of tests which actually passed + my $actual_passed = $parser->actual_passed; + +This method lets you know which (or how many) tests actually passed, +regardless of whether or not a TODO directive was found. + +=cut + +sub actual_passed { + return @{ $_[0]->{actual_passed} } + if ref $_[0]->{actual_passed}; + return wantarray ? 1 .. $_[0]->{actual_passed} : $_[0]->{actual_passed}; +} +*actual_ok = \&actual_passed; + +=head3 C + +This method is a synonym for C. + +=head3 C + + # the test numbers which actually failed + my @actual_failed = $parser->actual_failed; + + # the number of tests which actually failed + my $actual_failed = $parser->actual_failed; + +This method lets you know which (or how many) tests actually failed, +regardless of whether or not a TODO directive was found. + +=cut + +sub actual_failed { @{ shift->{actual_failed} } } + +############################################################################## + +=head3 C + + my @todo = $parser->todo; # the test numbers with todo directives + my $todo = $parser->todo; # the number of tests with todo directives + +This method lets you know which (or how many) tests had TODO directives. + +=cut + +sub todo { @{ shift->{todo} } } + +=head3 C + + # the test numbers which unexpectedly succeeded + my @todo_passed = $parser->todo_passed; + + # the number of tests which unexpectedly succeeded + my $todo_passed = $parser->todo_passed; + +This method lets you know which (or how many) tests actually passed but were +declared as "TODO" tests. + +=cut + +sub todo_passed { @{ shift->{todo_passed} } } + +############################################################################## + +=head3 C + + # deprecated in favor of 'todo_passed'. This method was horribly misnamed. + +This was a badly misnamed method. It indicates which TODO tests unexpectedly +succeeded. Will now issue a warning and call C. + +=cut + +sub todo_failed { + warn + '"todo_failed" is deprecated. Please use "todo_passed". See the docs.'; + goto &todo_passed; +} + +=head3 C + + my @skipped = $parser->skipped; # the test numbers with SKIP directives + my $skipped = $parser->skipped; # the number of tests with SKIP directives + +This method lets you know which (or how many) tests had SKIP directives. + +=cut + +sub skipped { @{ shift->{skipped} } } + +=head2 Pragmas + +=head3 C + +Get or set a pragma. To get the state of a pragma: + + if ( $p->pragma('strict') ) { + # be strict + } + +To set the state of a pragma: + + $p->pragma('strict', 1); # enable strict mode + +=cut + +sub pragma { + my ( $self, $pragma ) = splice @_, 0, 2; + + return $self->{pragma}->{$pragma} unless @_; + + if ( my $state = shift ) { + $self->{pragma}->{$pragma} = 1; + } + else { + delete $self->{pragma}->{$pragma}; + } + + return; +} + +=head3 C + +Get a list of all the currently enabled pragmas: + + my @pragmas_enabled = $p->pragmas; + +=cut + +sub pragmas { sort keys %{ shift->{pragma} || {} } } + +=head2 Summary Results + +These results are "meta" information about the total results of an individual +test program. + +=head3 C + + my $plan = $parser->plan; + +Returns the test plan, if found. + +=head3 C + +Deprecated. Use C instead. + +=cut + +sub good_plan { + warn 'good_plan() is deprecated. Please use "is_good_plan()"'; + goto &is_good_plan; +} + +############################################################################## + +=head3 C + + if ( $parser->is_good_plan ) { ... } + +Returns a boolean value indicating whether or not the number of tests planned +matches the number of tests run. + +B this was formerly C. The latter method is deprecated and +will issue a warning. + +And since we're on that subject ... + +=head3 C + + print $parser->tests_planned; + +Returns the number of tests planned, according to the plan. For example, a +plan of '1..17' will mean that 17 tests were planned. + +=head3 C + + print $parser->tests_run; + +Returns the number of tests which actually were run. Hopefully this will +match the number of C<< $parser->tests_planned >>. + +=head3 C + +Returns a true value (actually the reason for skipping) if all tests +were skipped. + +=head3 C + +Returns the wall-clock time when the Parser was created. + +=head3 C + +Returns the wall-clock time when the end of TAP input was seen. + +=head3 C + +Returns the CPU times (like L when the Parser was created. + +=head3 C + +Returns the CPU times (like L when the end of TAP +input was seen. + +=head3 C + + if ( $parser->has_problems ) { + ... + } + +This is a 'catch-all' method which returns true if any tests have currently +failed, any TODO tests unexpectedly succeeded, or any parse errors occurred. + +=cut + +sub has_problems { + my $self = shift; + return + $self->failed + || $self->parse_errors + || ( !$self->ignore_exit && ( $self->wait || $self->exit ) ); +} + +=head3 C + + $parser->version; + +Once the parser is done, this will return the version number for the +parsed TAP. Version numbers were introduced with TAP version 13 so if no +version number is found version 12 is assumed. + +=head3 C + + $parser->exit; + +Once the parser is done, this will return the exit status. If the parser ran +an executable, it returns the exit status of the executable. + +=head3 C + + $parser->wait; + +Once the parser is done, this will return the wait status. If the parser ran +an executable, it returns the wait status of the executable. Otherwise, this +merely returns the C status. + +=head2 C + + $parser->ignore_exit(1); + +Tell the parser to ignore the exit status from the test when determining +whether the test passed. Normally tests with non-zero exit status are +considered to have failed even if all individual tests passed. In cases +where it is not possible to control the exit value of the test script +use this option to ignore it. + +=cut + +sub ignore_exit { shift->pragma( 'ignore_exit', @_ ) } + +=head3 C + + my @errors = $parser->parse_errors; # the parser errors + my $errors = $parser->parse_errors; # the number of parser_errors + +Fortunately, all TAP output is perfect. In the event that it is not, this +method will return parser errors. Note that a junk line which the parser does +not recognize is C an error. This allows this parser to handle future +versions of TAP. The following are all TAP errors reported by the parser: + +=over 4 + +=item * Misplaced plan + +The plan (for example, '1..5'), must only come at the beginning or end of the +TAP output. + +=item * No plan + +Gotta have a plan! + +=item * More than one plan + + 1..3 + ok 1 - input file opened + not ok 2 - first line of the input valid # todo some data + ok 3 read the rest of the file + 1..3 + +Right. Very funny. Don't do that. + +=item * Test numbers out of sequence + + 1..3 + ok 1 - input file opened + not ok 2 - first line of the input valid # todo some data + ok 2 read the rest of the file + +That last test line above should have the number '3' instead of '2'. + +Note that it's perfectly acceptable for some lines to have test numbers and +others to not have them. However, when a test number is found, it must be in +sequence. The following is also an error: + + 1..3 + ok 1 - input file opened + not ok - first line of the input valid # todo some data + ok 2 read the rest of the file + +But this is not: + + 1..3 + ok - input file opened + not ok - first line of the input valid # todo some data + ok 3 read the rest of the file + +=back + +=cut + +sub parse_errors { @{ shift->{parse_errors} } } + +sub _add_error { + my ( $self, $error ) = @_; + push @{ $self->{parse_errors} } => $error; + return $self; +} + +sub _make_state_table { + my $self = shift; + my %states; + my %planned_todo = (); + + # These transitions are defaults for all states + my %state_globals = ( + comment => {}, + bailout => {}, + yaml => {}, + version => { + act => sub { + $self->_add_error( + 'If TAP version is present it must be the first line of output' + ); + }, + }, + unknown => { + act => sub { + my $unk = shift; + if ( $self->pragma('strict') ) { + $self->_add_error( + 'Unknown TAP token: "' . $unk->raw . '"' ); + } + }, + }, + pragma => { + act => sub { + my ($pragma) = @_; + for my $pr ( $pragma->pragmas ) { + if ( $pr =~ /^ ([-+])(\w+) $/x ) { + $self->pragma( $2, $1 eq '+' ); + } + } + }, + }, + ); + + # Provides default elements for transitions + my %state_defaults = ( + plan => { + act => sub { + my ($plan) = @_; + $self->tests_planned( $plan->tests_planned ); + $self->plan( $plan->plan ); + if ( $plan->has_skip ) { + $self->skip_all( $plan->explanation + || '(no reason given)' ); + } + + $planned_todo{$_}++ for @{ $plan->todo_list }; + }, + }, + test => { + act => sub { + my ($test) = @_; + + my ( $number, $tests_run ) + = ( $test->number, ++$self->{tests_run} ); + + # Fake TODO state + if ( defined $number && delete $planned_todo{$number} ) { + $test->set_directive('TODO'); + } + + my $has_todo = $test->has_todo; + + $self->in_todo($has_todo); + if ( defined( my $tests_planned = $self->tests_planned ) ) { + if ( $tests_run > $tests_planned ) { + $test->is_unplanned(1); + } + } + + if ( defined $number ) { + if ( $number != $tests_run ) { + my $count = $tests_run; + $self->_add_error( "Tests out of sequence. Found " + . "($number) but expected ($count)" ); + } + } + else { + $test->_number( $number = $tests_run ); + } + + push @{ $self->{todo} } => $number if $has_todo; + push @{ $self->{todo_passed} } => $number + if $test->todo_passed; + push @{ $self->{skipped} } => $number + if $test->has_skip; + + push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } => + $number; + push @{ + $self->{ + $test->is_actual_ok + ? 'actual_passed' + : 'actual_failed' + } + } => $number; + }, + }, + yaml => { act => sub { }, }, + ); + + # Each state contains a hash the keys of which match a token type. For + # each token + # type there may be: + # act A coderef to run + # goto The new state to move to. Stay in this state if + # missing + # continue Goto the new state and run the new state for the + # current token + %states = ( + INIT => { + version => { + act => sub { + my ($version) = @_; + my $ver_num = $version->version; + if ( $ver_num <= $DEFAULT_TAP_VERSION ) { + my $ver_min = $DEFAULT_TAP_VERSION + 1; + $self->_add_error( + "Explicit TAP version must be at least " + . "$ver_min. Got version $ver_num" ); + $ver_num = $DEFAULT_TAP_VERSION; + } + if ( $ver_num > $MAX_TAP_VERSION ) { + $self->_add_error( + "TAP specified version $ver_num but " + . "we don't know about versions later " + . "than $MAX_TAP_VERSION" ); + $ver_num = $MAX_TAP_VERSION; + } + $self->version($ver_num); + $self->_grammar->set_version($ver_num); + }, + goto => 'PLAN' + }, + plan => { goto => 'PLANNED' }, + test => { goto => 'UNPLANNED' }, + }, + PLAN => { + plan => { goto => 'PLANNED' }, + test => { goto => 'UNPLANNED' }, + }, + PLANNED => { + test => { goto => 'PLANNED_AFTER_TEST' }, + plan => { + act => sub { + my ($version) = @_; + $self->_add_error( + 'More than one plan found in TAP output'); + }, + }, + }, + PLANNED_AFTER_TEST => { + test => { goto => 'PLANNED_AFTER_TEST' }, + plan => { act => sub { }, continue => 'PLANNED' }, + yaml => { goto => 'PLANNED' }, + }, + GOT_PLAN => { + test => { + act => sub { + my ($plan) = @_; + my $line = $self->plan; + $self->_add_error( + "Plan ($line) must be at the beginning " + . "or end of the TAP output" ); + $self->is_good_plan(0); + }, + continue => 'PLANNED' + }, + plan => { continue => 'PLANNED' }, + }, + UNPLANNED => { + test => { goto => 'UNPLANNED_AFTER_TEST' }, + plan => { goto => 'GOT_PLAN' }, + }, + UNPLANNED_AFTER_TEST => { + test => { act => sub { }, continue => 'UNPLANNED' }, + plan => { act => sub { }, continue => 'UNPLANNED' }, + yaml => { goto => 'UNPLANNED' }, + }, + ); + + # Apply globals and defaults to state table + for my $name ( keys %states ) { + + # Merge with globals + my $st = { %state_globals, %{ $states{$name} } }; + + # Add defaults + for my $next ( sort keys %{$st} ) { + if ( my $default = $state_defaults{$next} ) { + for my $def ( sort keys %{$default} ) { + $st->{$next}->{$def} ||= $default->{$def}; + } + } + } + + # Stuff back in table + $states{$name} = $st; + } + + return \%states; +} + +=head3 C + +Get an a list of file handles which can be passed to C