diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-01-21 14:46:38 +0000 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-01-21 14:46:38 +0000 |
commit | 3c87ea76a29c989d68c834cb6f9fd80a9892d62a (patch) | |
tree | 571bd5825d2f046b0575c24371eee0aa278bdb17 /lib | |
parent | f31c3107030f031d9abc088f3d5f450116edba5b (diff) | |
download | perl-3c87ea76a29c989d68c834cb6f9fd80a9892d62a.tar.gz |
Upgrade to Test::Harness 2.46
p4raw-id: //depot/perl@23847
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Test/Harness.pm | 335 | ||||
-rw-r--r-- | lib/Test/Harness/Assert.pm | 2 | ||||
-rw-r--r-- | lib/Test/Harness/Changes | 73 | ||||
-rw-r--r-- | lib/Test/Harness/Iterator.pm | 2 | ||||
-rw-r--r-- | lib/Test/Harness/Straps.pm | 110 | ||||
-rw-r--r-- | lib/Test/Harness/TAP.pod | 175 | ||||
-rw-r--r-- | lib/Test/Harness/t/harness.t | 22 | ||||
-rw-r--r-- | lib/Test/Harness/t/prove-globbing.t | 31 | ||||
-rw-r--r-- | lib/Test/Harness/t/prove-switches.t | 4 | ||||
-rw-r--r-- | lib/Test/Harness/t/strap.t | 5 |
10 files changed, 432 insertions, 327 deletions
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index b6e46a1b6e..5596ecd584 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -1,9 +1,8 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Harness.pm,v 1.85 2004/04/29 03:13:43 andy Exp $ package Test::Harness; -require 5.004; +require 5.00405; use Test::Harness::Straps; use Test::Harness::Assert; use Exporter; @@ -16,7 +15,6 @@ use vars qw( @ISA @EXPORT @EXPORT_OK $Verbose $Switches $Debug $verbose $switches $debug - $Have_Devel_Corestack $Curtest $Columns $ML $Last_ML_Print @@ -29,21 +27,17 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 2.42; - - $Header: /home/cvs/test-harness/lib/Test/Harness.pm,v 1.85 2004/04/29 03:13:43 andy Exp $ +Version 2.46 =cut -$VERSION = '2.42'; +$VERSION = "2.46"; # Backwards compatibility for exportable variable names. *verbose = *Verbose; *switches = *Switches; *debug = *Debug; -$Have_Devel_Corestack = 0; - $ENV{HARNESS_ACTIVE} = 1; END { @@ -56,10 +50,10 @@ my $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE}; my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR}; -my $Ok_Slow = $ENV{HARNESS_OK_SLOW}; - $Strap = Test::Harness::Straps->new; +sub strap { return $Strap }; + @ISA = ('Exporter'); @EXPORT = qw(&runtests); @EXPORT_OK = qw($verbose $switches); @@ -78,165 +72,21 @@ $Columns--; # Some shells have trouble with a full line of text. =head1 DESCRIPTION -B<STOP!> If all you want to do is write a test script, consider using -Test::Simple. Otherwise, read on. - -(By using the Test module, you can write test scripts without -knowing the exact output this module expects. However, if you need to -know the specifics, read on!) - -Perl test scripts print to standard output C<"ok N"> for each single -test, where C<N> is an increasing sequence of integers. The first line -output by a standard test script is C<"1..M"> with C<M> being the -number of tests that should be run within the test -script. Test::Harness::runtests(@tests) runs all the testscripts -named as arguments and checks standard output for the expected -C<"ok N"> strings. - -After all tests have been performed, runtests() prints some -performance statistics that are computed by the Benchmark module. - -=head2 The test script output - -The following explains how Test::Harness interprets the output of your -test program. - -=over 4 - -=item B<'1..M'> - -This header tells how many tests there will be. For example, C<1..10> -means you plan on running 10 tests. This is a safeguard in case your -test dies quietly in the middle of its run. - -It should be the first non-comment line output by your test program. - -In certain instances, you may not know how many tests you will -ultimately be running. In this case, it is permitted for the 1..M -header to appear as the B<last> line output by your test (again, it -can be followed by further comments). - -Under B<no> circumstances should 1..M appear in the middle of your -output or more than once. - - -=item B<'ok', 'not ok'. Ok?> - -Any output from the testscript to standard error is ignored and -bypassed, thus will be seen by the user. Lines written to standard -output containing C</^(not\s+)?ok\b/> are interpreted as feedback for -runtests(). All other lines are discarded. - -C</^not ok/> indicates a failed test. C</^ok/> is a successful test. - - -=item B<test numbers> - -Perl normally expects the 'ok' or 'not ok' to be followed by a test -number. It is tolerated if the test numbers after 'ok' are -omitted. In this case Test::Harness maintains temporarily its own -counter until the script supplies test numbers again. So the following -test script - - print <<END; - 1..6 - not ok - ok - not ok - ok - ok - END - -will generate - - FAILED tests 1, 3, 6 - Failed 3/6 tests, 50.00% okay - -=item B<test names> - -Anything after the test number but before the # is considered to be -the name of the test. - - ok 42 this is the name of the test - -Currently, Test::Harness does nothing with this information. - -=item B<Skipping tests> - -If the standard output line contains the substring C< # Skip> (with -variations in spacing and case) after C<ok> or C<ok NUMBER>, it is -counted as a skipped test. If the whole testscript succeeds, the -count of skipped tests is included in the generated output. -C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason -for skipping. - - ok 23 # skip Insufficient flogiston pressure. - -Similarly, one can include a similar explanation in a C<1..0> line -emitted if the test script is skipped completely: - - 1..0 # Skipped: no leverage found - -=item B<Todo tests> - -If the standard output line contains the substring C< # TODO > after -C<not ok> or C<not ok NUMBER>, it is counted as a todo test. The text -afterwards is the thing that has to be done before this test will -succeed. - - not ok 13 # TODO harness the power of the atom - -Note that the TODO must have a space after it. - -=begin _deprecated - -Alternatively, you can specify a list of what tests are todo as part -of the test header. - - 1..23 todo 5 12 23 - -This only works if the header appears at the beginning of the test. - -This style is B<deprecated>. - -=end _deprecated - -These tests represent a feature to be implemented or a bug to be fixed -and act as something of an executable "thing to do" list. They are -B<not> expected to succeed. Should a todo test begin succeeding, -Test::Harness will report it as a bonus. This indicates that whatever -you were supposed to do has been done and you should promote this to a -normal test. - -=item B<Bail out!> - -As an emergency measure, a test script can decide that further tests -are useless (e.g. missing dependencies) and testing should stop -immediately. In that case the test script prints the magic words - - Bail out! - -to standard output. Any message after these words will be displayed by -C<Test::Harness> as the reason why testing is stopped. - -=item B<Comments> - -Additional comments may be put into the testing output on their own -lines. Comment lines should begin with a '#', Test::Harness will -ignore them. +B<STOP!> If all you want to do is write a test script, consider +using Test::Simple. Test::Harness is the module that reads the +output from Test::Simple, Test::More and other modules based on +Test::Builder. You don't need to know about Test::Harness to use +those modules. - ok 1 - # Life is good, the sun is shining, RAM is cheap. - not ok 2 - # got 'Bush' expected 'Gore' +Test::Harness runs tests and expects output from the test in a +certain format. That format is called TAP, the Test Anything +Protocol. It is defined in L<Test::Harness::TAP>. -=item B<Anything else> +C<Test::Harness::runtests(@tests)> runs all the testscripts named +as arguments and checks standard output for the expected strings +in TAP format. -Any other output Test::Harness sees it will silently ignore B<BUT WE -PLAN TO CHANGE THIS!> If you wish to place additional output in your -test script, please use a comment. - -=back +The F<prove> utility is a thin wrapper around Test::Harness. =head2 Taint mode @@ -254,16 +104,16 @@ Test::Harness. They are exported on request. =over 4 -=item B<$Test::Harness::Verbose> +=item C<$Test::Harness::Verbose> -The global variable C<$Test::Harness::Verbose> is exportable and can be +The package variable C<$Test::Harness::Verbose> is exportable and can be used to let C<runtests()> display the standard output of the script without altering the behavior otherwise. The F<prove> utility's C<-v> flag will set this. -=item B<$Test::Harness::switches> +=item C<$Test::Harness::switches> -The global variable C<$Test::Harness::switches> is exportable and can be +The package variable C<$Test::Harness::switches> is exportable and can be used to set perl command line options used for running the test script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>. @@ -272,8 +122,7 @@ script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>. =head2 Failure -It will happen: your tests will fail. After you mop up your ego, you -can begin examining the summary report: +When tests fail, analyze the summary report: t/base..............ok t/nonumbers.........ok @@ -288,7 +137,7 @@ can begin examining the summary report: t/waterloo.t 3 768 20 10 50.00% 1 3 5 7 9 11 13 15 17 19 Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay. -Everything passed but t/waterloo.t. It failed 10 of 20 tests and +Everything passed but F<t/waterloo.t>. It failed 10 of 20 tests and exited with non-zero status indicating something dubious happened. The columns in the summary report mean: @@ -338,18 +187,14 @@ Test::Harness currently only has one function, here it is. my $allok = runtests(@test_files); -This runs all the given @test_files and divines whether they passed +This runs all the given I<@test_files> and divines whether they passed or failed based on their output to STDOUT (details above). It prints out each individual test which failed along with a summary report and a how long it all took. -It returns true if everything was ok. Otherwise it will die() with +It returns true if everything was ok. Otherwise it will C<die()> with one of the messages in the DIAGNOSTICS section. -=for _private - -This is just _run_all_tests() plus _show_results() - =cut sub runtests { @@ -389,7 +234,7 @@ sub _all_ok { my @files = _globdir $dir; Returns all the files in a directory. This is shorthand for backwards -compatibility on systems where glob() doesn't work right. +compatibility on systems where C<glob()> doesn't work right. =cut @@ -442,10 +287,20 @@ B<NOTE> Currently this function is still noisy. I'm working on it. =cut -#'# +# Turns on autoflush for the handle passed +sub _autoflush { + my $flushy_fh = shift; + my $old_fh = select $flushy_fh; + $| = 1; + select $old_fh; +} + sub _run_all_tests { - my(@tests) = @_; - local($|) = 1; + my @tests = @_; + + _autoflush(\*STDOUT); + _autoflush(\*STDERR); + my(%failedtests); # Test-wide totals. @@ -469,10 +324,6 @@ sub _run_all_tests { my $width = _leader_width(@tests); foreach my $tfile (@tests) { - if ( $Test::Harness::Debug ) { - print "# Running: ", $Strap->_command_line($tfile), "\n"; - } - $Last_ML_Print = 0; # so each test prints at least once my($leader, $ml) = _mk_leader($tfile, $width); local $ML = $ml; @@ -482,6 +333,9 @@ sub _run_all_tests { $tot{files}++; $Strap->{_seen_header} = 0; + if ( $Test::Harness::Debug ) { + print "# Running: ", $Strap->_command_line($tfile), "\n"; + } my %results = $Strap->analyze_file($tfile) or do { warn $Strap->{error}, "\n"; next }; @@ -535,8 +389,7 @@ sub _run_all_tests { # List overruns as failures. else { my $details = $results{details}; - foreach my $overrun ($test{max}+1..@$details) - { + foreach my $overrun ($test{max}+1..@$details) { next unless ref $details->[$overrun-1]; push @{$test{failed}}, $overrun } @@ -598,7 +451,7 @@ sub _run_all_tests { @dir_files = @new_dir_files; } } - } + } # foreach test $tot{bench} = timediff(new Benchmark, $t_start); $Strap->_restore_PERL5LIB; @@ -610,7 +463,7 @@ sub _run_all_tests { my($leader, $ml) = _mk_leader($test_file, $width); -Generates the 't/foo........' $leader for the given C<$test_file> as well +Generates the 't/foo........' leader for the given C<$test_file> as well as a similar version which will overwrite the current line (by use of \r and such). C<$ml> may be empty if Test::Harness doesn't think you're on TTY. @@ -700,8 +553,14 @@ sub _show_results { } -my %Handlers = (); -$Strap->{callback} = sub { +my %Handlers = ( + header => \&header_handler, + test => \&test_handler, + bailout => \&bailout_handler, +); + +$Strap->{callback} = \&strap_callback; +sub strap_callback { my($self, $line, $type, $totals) = @_; print $line if $Verbose; @@ -710,7 +569,7 @@ $Strap->{callback} = sub { }; -$Handlers{header} = sub { +sub header_handler { my($self, $line, $type, $totals) = @_; warn "Test header seen more than once!\n" if $self->{_seen_header}; @@ -722,7 +581,7 @@ $Handlers{header} = sub { $totals->{max} < $totals->{seen}; }; -$Handlers{test} = sub { +sub test_handler { my($self, $line, $type, $totals) = @_; my $curr = $totals->{seen}; @@ -754,7 +613,7 @@ $Handlers{test} = sub { }; -$Handlers{bailout} = sub { +sub bailout_handler { my($self, $line, $type, $totals) = @_; die "FAILED--Further testing stopped" . @@ -770,7 +629,7 @@ sub _print_ml { # For slow connections, we save lots of bandwidth by printing only once # per second. sub _print_ml_less { - if( !$Ok_Slow || $Last_ML_Print != time ) { + if ( $Last_ML_Print != time ) { _print_ml(@_); $Last_ML_Print = time; } @@ -812,14 +671,6 @@ sub _dubious_return { $wstatus,$wstatus; print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS'; - if (_corestatus($wstatus)) { # until we have a wait module - if ($Have_Devel_Corestack) { - Devel::CoreStack::stack($^X); - } else { - print "\ttest program seems to have generated a core\n"; - } - } - $tot->{bad}++; if ($test->{max}) { @@ -898,29 +749,6 @@ sub _create_fmts { return($fmt_top, $fmt); } -{ - my $tried_devel_corestack; - - sub _corestatus { - my($st) = @_; - - my $did_core; - eval { # we may not have a WCOREDUMP - local $^W = 0; # *.ph files are often *very* noisy - require 'wait.ph'; - $did_core = WCOREDUMP($st); - }; - if( $@ ) { - $did_core = $st & 0200; - } - - eval { require Devel::CoreStack; $Have_Devel_Corestack++ } - unless $tried_devel_corestack++; - - return $did_core; - } -} - sub _canonfailed ($$@) { my($max,$skipped,@failed) = @_; my %seen; @@ -958,8 +786,8 @@ sub _canonfailed ($$@) { push @result, "?% okay"; } my $ender = 's' x ($skipped > 1); - my $good = $max - $failed - $skipped; if ($skipped) { + my $good = $max - $failed - $skipped; my $skipmsg = " (less $skipped skipped test$ender: $good okay, "; if ($max) { my $goodper = sprintf("%.2f",100*($good/$max)); @@ -1079,12 +907,6 @@ output more frequent progress messages using carriage returns. Some consoles may not handle carriage returns properly (which results in a somewhat messy output). -=item C<HARNESS_OK_SLOW> - -If true, the C<ok> messages are printed out only every second. This -reduces output and may help increase testing speed over slow -connections, or with very large numbers of tests. - =item C<HARNESS_PERL> Usually your tests will be run by C<$^X>, the currently-executing Perl. @@ -1126,27 +948,9 @@ Here's how Test::Harness tests itself The included F<prove> utility for running test scripts from the command line, L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for -the underlying timing routines, L<Devel::CoreStack> to generate core -dumps from failed tests and L<Devel::Cover> for test coverage +the underlying timing routines, and L<Devel::Cover> for test coverage analysis. -=head1 AUTHORS - -Either Tim Bunce or Andreas Koenig, we don't know. What we know for -sure is, that it was inspired by Larry Wall's TEST script that came -with perl distributions for ages. Numerous anonymous contributors -exist. Andreas Koenig held the torch for many years, and then -Michael G Schwern. - -Current maintainer is Andy Lester C<< <andy@petdance.com> >>. - -=head1 LICENSE - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -See L<http://www.perl.com/perl/misc/Artistic.html> - =head1 TODO Provide a way of running tests quietly (ie. no printing) for automated @@ -1163,8 +967,6 @@ Figure a way to report test names in the failure summary. Rework the test summary so long test names are not truncated as badly. (Partially done with new skip test styles) -Deal with VMS's "not \nok 4\n" mistake. - Add option for coverage analysis. Trap STDERR. @@ -1191,12 +993,8 @@ Fix stats display when there's an overrun. Fix so perls with spaces in the filename work. -=for _private - Keeping whittling away at _run_all_tests() -=for _private - Clean up how the summary is printed. Get rid of those damned formats. =head1 BUGS @@ -1206,16 +1004,23 @@ directory. Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>. You can also mail bugs, fixes and enhancements to -C<< <bug-test-harness@rt.cpan.org> >>. +C<< <bug-test-harness >> at C<< rt.cpan.org> >>. =head1 AUTHORS -Original code by Michael G Schwern, maintained by Andy Lester. +Either Tim Bunce or Andreas Koenig, we don't know. What we know for +sure is, that it was inspired by Larry Wall's TEST script that came +with perl distributions for ages. Numerous anonymous contributors +exist. Andreas Koenig held the torch for many years, and then +Michael G Schwern. + +Current maintainer is Andy Lester C<< <andy at petdance.com> >>. =head1 COPYRIGHT -Copyright 2003 by Michael G Schwern C<< <schwern@pobox.com> >>, - Andy Lester C<< <andy@petdance.com> >>. +Copyright 2002-2005 +by Michael G Schwern C<< <schwern at pobox.com> >>, +Andy Lester C<< <andy at petdance.com> >>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/Test/Harness/Assert.pm b/lib/Test/Harness/Assert.pm index 09912bacad..dc09e402c5 100644 --- a/lib/Test/Harness/Assert.pm +++ b/lib/Test/Harness/Assert.pm @@ -1,4 +1,4 @@ -# $Id: Assert.pm,v 1.3 2003/09/11 15:57:29 andy Exp $ +# $Id: Assert.pm 250 2003-09-11 15:57:29Z andy $ package Test::Harness::Assert; diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index 2ad03c0060..6d87f4a062 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,78 @@ Revision history for Perl extension Test::Harness +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. diff --git a/lib/Test/Harness/Iterator.pm b/lib/Test/Harness/Iterator.pm index adb0727c83..00caf9e55e 100644 --- a/lib/Test/Harness/Iterator.pm +++ b/lib/Test/Harness/Iterator.pm @@ -55,6 +55,8 @@ sub new { package Test::Harness::Iterator::FH; sub next { my $fh = $_[0]->{fh}; + + # readline() doesn't work so good on 5.5.4. return scalar <$fh>; } diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 27f5602f5c..ce7fa9ada4 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -1,12 +1,12 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Straps.pm,v 1.35 2003/12/31 02:34:22 andy Exp $ +# $Id: Straps.pm 450 2004-12-20 04:51:42Z andy $ package Test::Harness::Straps; use strict; use vars qw($VERSION); use Config; -$VERSION = '0.19'; +$VERSION = '0.20'; use Test::Harness::Assert; use Test::Harness::Iterator; @@ -69,8 +69,7 @@ Initialize a new strap. =cut sub new { - my($proto) = shift; - my($class) = ref $proto || $proto; + my $class = shift; my $self = bless {}, $class; $self->_init; @@ -96,7 +95,7 @@ sub _init { =head1 Analysis -=head2 C<analyze> +=head2 $strap->analyze( $name, \@output_lines ) my %results = $strap->analyze($name, \@test_output); @@ -161,14 +160,7 @@ sub _analyze_line { $self->{line}++; my $type; - if( $self->_is_header($line) ) { - $type = 'header'; - - $self->{saw_header}++; - - $totals->{max} += $self->{max}; - } - elsif( $self->_is_test($line, \%result) ) { + if ( $self->_is_test($line, \%result) ) { $type = 'test'; $totals->{seen}++; @@ -204,12 +196,34 @@ sub _analyze_line { warn "Can't detailize, too big.\n"; } else { - $totals->{details}[$result{number} - 1] = - {$self->_detailize($pass, \%result)}; + #Generates the details based on the last test line seen. C<$pass> is + #true if it was considered to be a passed test. C<%test> is the results + #of the test you're summarizing. + my $details = { + ok => $pass, + actual_ok => $result{ok} + }; + + assert( defined( $details->{ok} ) && defined( $details->{actual_ok} ) ); + + # We don't want these to be undef because they are often + # checked and don't want the checker to have to deal with + # uninitialized vars. + foreach my $piece (qw(name type reason)) { + $details->{$piece} = defined $result{$piece} ? $result{$piece} : ''; + } + $totals->{details}[$result{number} - 1] = $details; } # XXX handle counter mismatch } + elsif ( $self->_is_header($line) ) { + $type = 'header'; + + $self->{saw_header}++; + + $totals->{max} += $self->{max}; + } elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) { $type = 'bailout'; $self->{saw_bailout} = 1; @@ -235,7 +249,7 @@ sub analyze_fh { my($self, $name, $fh) = @_; my $it = Test::Harness::Iterator->new($fh); - $self->_analyze_iterator($name, $it); + return $self->_analyze_iterator($name, $it); } =head2 C<analyze_file> @@ -261,6 +275,10 @@ sub analyze_file { } local $ENV{PERL5LIB} = $self->_INC2PERL5LIB; + if ( $Test::Harness::Debug ) { + local $^W=0; # ignore undef warnings + print "# PERL5LIB=$ENV{PERL5LIB}\n"; + } # *sigh* this breaks under taint, but open -| is unportable. my $line = $self->_command_line($file); @@ -446,9 +464,21 @@ sub _filtered_INC { s/[\\\/+]$// foreach @inc; } - my %dupes; - @inc = grep !$dupes{$_}++, @inc; + my %seen; + $seen{$_}++ foreach $self->_default_inc(); + @inc = grep !$seen{$_}++, @inc; + + return @inc; +} + +sub _default_inc { + my $self = shift; + + local $ENV{PERL5LIB}; + my $perl = $self->_command; + my @inc =`$perl -le "print join qq[\n], \@INC"`; + chomp @inc; return @inc; } @@ -555,7 +585,7 @@ result back in C<%test> which will contain: type 'todo' or 'skip' (if any) reason why is it todo or skip? (if any) -If will also catch lone 'not' lines, note it saw them +It will also catch lone 'not' lines, note it saw them in C<< $strap->{saw_lone_not} >> and the line in C<< $strap->{lone_not_line} >>. =cut @@ -569,23 +599,16 @@ my $Report_Re = <<'REGEX'; (.*) # and the rest REGEX -my $Extra_Re = <<'REGEX'; - ^ - (.*?) (?:(?:[^\\]|^)# (.*))? - $ -REGEX - sub _is_test { my($self, $line, $test) = @_; # We pulverize the line down into pieces in three parts. if( my($not, $num, $extra) = $line =~ /$Report_Re/ox ) { - my ($name, $control) = $extra ? split(/(?:[^\\]|^)#/, $extra) : (); - my ($type, $reason) = $control ? $control =~ /^\s*(\S+)(?:\s+(.*))?$/ : (); + ($test->{name}, my $control) = $extra ? split(/(?:[^\\]|^)#/, $extra) : (); + (my $type, $test->{reason}) = $control ? $control =~ /^\s*(\S+)(?:\s+(.*))?$/ : (); $test->{number} = $num; $test->{ok} = $not ? 0 : 1; - $test->{name} = $name; if( defined $type ) { $test->{type} = $type =~ /^TODO$/i ? 'todo' : @@ -594,7 +617,6 @@ sub _is_test { else { $test->{type} = ''; } - $test->{reason} = $reason; return $YES; } @@ -697,36 +719,6 @@ There is one final item, the details. Element 0 of the details is test #1. I tried it with element 1 being #1 and 0 being empty, this is less awkward. -=head2 C<_detailize> - - my %details = $strap->_detailize($pass, \%test); - -Generates the details based on the last test line seen. C<$pass> is -true if it was considered to be a passed test. C<%test> is the results -of the test you're summarizing. - -=cut - -sub _detailize { - my($self, $pass, $test) = @_; - - my %details = ( ok => $pass, - actual_ok => $test->{ok} - ); - - assert( !(grep !defined $details{$_}, keys %details), - 'test contains the ok and actual_ok info' ); - - # We don't want these to be undef because they are often - # checked and don't want the checker to have to deal with - # uninitialized vars. - foreach my $piece (qw(name type reason)) { - $details{$piece} = defined $test->{$piece} ? $test->{$piece} : ''; - } - - return %details; -} - =head1 EXAMPLES See F<examples/mini_harness.plx> for an example of use. diff --git a/lib/Test/Harness/TAP.pod b/lib/Test/Harness/TAP.pod new file mode 100644 index 0000000000..b968aa865a --- /dev/null +++ b/lib/Test/Harness/TAP.pod @@ -0,0 +1,175 @@ +=head1 NAME + +Test::Harness::TAP - Documentation for the TAP format + +=head1 SYNOPSIS + +Perl's interface between testing modules like Test::More and the +test harness Test::Harness is a simple text-based format called +TAP, the Test Anything Protocol. This is its story. + +=head1 TERMINOLOGY + +The "interpreter" is the program that reads and analyzes some TAP +output. In Perl, this is handled by the C<Test::Harness> module, +with the C<runtests()> function. + +=head1 THE TAP FORMAT + +Perl test scripts print to standard output C<"ok N"> for each single +test, where C<N> is an increasing sequence of integers. The first +line output by a standard test script is C<"1..M"> with C<M> being +the number of tests that should be run within the test script. + +After all tests have been performed, runtests() prints some performance +statistics that are computed by the Benchmark module. + +=head2 The test script output + +The following explains how Test::Harness interprets the output of your +test program. + +=over 4 + +=item B<"1..M"> + +This header tells how many tests there will be. For example, C<1..10> +means you plan on running 10 tests. This is a safeguard in case +your test dies quietly in the middle of its run. + +It should be the first non-comment line output by your test program. + +In certain instances, you may not know how many tests you will +ultimately be running. In this case, it is permitted for the C<1..M> +header to appear as the B<last> line output by your test (again, +it can be followed by further comments). + +Under no circumstances should C<1..M> appear in the middle of your +output or more than once. + +=item B<'ok', 'not ok'. Ok?> + +Any output from the testscript to standard error is ignored and +bypassed, thus will be seen by the user. Lines written to standard +output containing C</^(not\s+)?ok\b/> are interpreted as feedback for +the TAP interpreter. All other lines are discarded. + +C</^not ok/> indicates a failed test. C</^ok/> is a successful test. + +=item B<test numbers> + +TAP normally expects the "ok" or "not ok" to be followed by a test +number. It is tolerated if the test numbers after "ok" are omitted. +In this case, the interpreter must temporarily maintain its own +counter until the script supplies test numbers again. So the following +test script + + print <<END; + 1..6 + not ok + ok + not ok + ok + ok + END + +will generate + + FAILED tests 1, 3, 6 + Failed 3/6 tests, 50.00% okay + +=item B<test labels> + +Anything after the test number, but before the "#", is considered +to be the label for the test. + + ok 42 this is the label of the test + +Currently, Test::Harness does nothing with this information. + +=item B<Skipping tests> + +If the standard output line contains the substring C< # Skip> (with +variations in spacing and case) after C<ok> or C<ok NUMBER>, it is +counted as a skipped test. If the whole testscript succeeds, the +count of skipped tests is included in the generated output. +C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason +for skipping. + + ok 23 # skip Insufficient flogiston pressure. + +Similarly, one can include a similar explanation in a C<1..0> line +emitted if the test script is skipped completely: + + 1..0 # Skipped: no leverage found + +=item B<Todo tests> + +If the standard output line contains the substring C< # TODO > after +C<not ok> or C<not ok NUMBER>, it is counted as a todo test. The text +afterwards is the thing that has to be done before this test will +succeed. + + not ok 13 # TODO harness the power of the atom + +Note that the TODO must have a space after it. + +These tests represent a feature to be implemented or a bug to be fixed +and act as something of an executable "thing to do" list. They are +B<not> expected to succeed. Should a todo test begin succeeding, +Test::Harness will report it as a bonus. This indicates that whatever +you were supposed to do has been done and you should promote this to a +normal test. + +=item B<Bail out!> + +As an emergency measure, a test script can decide that further tests +are useless (e.g. missing dependencies) and testing should stop +immediately. In that case the test script prints the magic words + + Bail out! + +to standard output. Any message after these words must be displayed +by the interpreter as the reason why testing must be stopped. + +=item B<Comments> + +Additional comments may be put into the testing output on their own +lines. Comment lines should begin with a '#', Test::Harness will +ignore them. + + ok 1 + # Life is good, the sun is shining, RAM is cheap. + not ok 2 + # got 'Bush' expected 'Gore' + +=item B<Anything else> + +Any other output Test::Harness sees it will silently ignore B<BUT WE +PLAN TO CHANGE THIS!> If you wish to place additional output in your +test script, please use a comment. + +=back + +=head1 DESCRIPTION + +=head1 RATIONALE + +=head1 ACKNOWLEDGEMENTS + +=head1 AUTHORS + +Andy Lester, based on the original Test::Harness documentation by Michael Schwern. + +=head1 COPYRIGHT + +Copyright 2003-2004 by +Michael G Schwern C<< <schwern@pobox.com> >>, +Andy Lester C<< <andy@petdance.com> >>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L<http://www.perl.com/perl/misc/Artistic.html>. + +=cut diff --git a/lib/Test/Harness/t/harness.t b/lib/Test/Harness/t/harness.t new file mode 100644 index 0000000000..33b8d24795 --- /dev/null +++ b/lib/Test/Harness/t/harness.t @@ -0,0 +1,22 @@ +#!/usr/bin/perl -Tw + +BEGIN { + if ( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +use Test::More tests => 2; + +BEGIN { + use_ok( 'Test::Harness' ); +} + +my $strap = Test::Harness->strap; +isa_ok( $strap, 'Test::Harness::Straps' ); diff --git a/lib/Test/Harness/t/prove-globbing.t b/lib/Test/Harness/t/prove-globbing.t new file mode 100644 index 0000000000..e0f3c864a6 --- /dev/null +++ b/lib/Test/Harness/t/prove-globbing.t @@ -0,0 +1,31 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use File::Spec; +use Test::More; +plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE}; +plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE"; + +plan tests => 1; + +my $prove = File::Spec->catfile( File::Spec->curdir, "blib", "script", "prove" ); +my $tests = File::Spec->catfile( 't', 'prove*.t' ); + +GLOBBAGE: { + my @actual = sort qx/$prove --dry $tests/; + chomp @actual; + + my @expected = ( + File::Spec->catfile( "t", "prove-globbing.t" ), + File::Spec->catfile( "t", "prove-switches.t" ), + ); + is_deeply( \@actual, \@expected, "Expands the wildcards" ); +} diff --git a/lib/Test/Harness/t/prove-switches.t b/lib/Test/Harness/t/prove-switches.t index 36426dfa53..85c08e395d 100644 --- a/lib/Test/Harness/t/prove-switches.t +++ b/lib/Test/Harness/t/prove-switches.t @@ -14,6 +14,10 @@ use Test::More; plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE}; plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE"; +# Work around a Cygwin bug. Remove this if Perl bug 30952 ever gets fixed. +# http://rt.perl.org/rt3/Ticket/Display.html?id=30952. +plan skip_all => "Skipping because of a Cygwin bug" if ( $^O =~ /cygwin/i ); + plan tests => 5; my $blib = File::Spec->catfile( File::Spec->curdir, "blib" ); diff --git a/lib/Test/Harness/t/strap.t b/lib/Test/Harness/t/strap.t index ab9d0da090..f1cba106c6 100644 --- a/lib/Test/Harness/t/strap.t +++ b/lib/Test/Harness/t/strap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl -Tw BEGIN { if( $ENV{PERL_CORE} ) { @@ -12,7 +12,7 @@ BEGIN { use strict; -use Test::More tests => 170; +use Test::More tests => 176; BEGIN { use_ok('Test::Harness::Straps'); } @@ -59,6 +59,7 @@ my @not_headers = (' 1..2', foreach my $unheader (@not_headers) { my $strap = Test::Harness::Straps->new; + isa_ok( $strap, 'Test::Harness::Straps' ); ok( !$strap->_is_header($unheader), "_is_header(), not a header '$unheader'" ); |