diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Test/Harness.pm | 25 | ||||
| -rw-r--r-- | lib/Test/Harness/Changes | 46 | ||||
| -rw-r--r-- | lib/Test/Harness/Straps.pm | 240 | ||||
| -rw-r--r-- | lib/Test/Harness/TAP.pod | 372 | ||||
| -rw-r--r-- | lib/Test/Harness/t/00compile.t | 6 | ||||
| -rw-r--r-- | lib/Test/Harness/t/strap-analyze.t | 958 | ||||
| -rw-r--r-- | lib/Test/Harness/t/strap.t | 89 |
7 files changed, 966 insertions, 770 deletions
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 5596ecd584..fcf59dd2f1 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -27,11 +27,11 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 2.46 +Version 2.48 =cut -$VERSION = "2.46"; +$VERSION = "2.48"; # Backwards compatibility for exportable variable names. *verbose = *Verbose; @@ -39,10 +39,12 @@ $VERSION = "2.46"; *debug = *Debug; $ENV{HARNESS_ACTIVE} = 1; +$ENV{HARNESS_VERSION} = $VERSION; END { # For VMS. delete $ENV{HARNESS_ACTIVE}; + delete $ENV{HARNESS_VERSION}; } # Some experimental versions of OS/2 build have broken $? @@ -852,15 +854,26 @@ the script dies with this message. =back -=head1 ENVIRONMENT +=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS + +Test::Harness sets these before executing the individual tests. =over 4 =item C<HARNESS_ACTIVE> -Harness sets this before executing the individual tests. This allows -the tests to determine if they are being executed through the harness -or by any other means. +This is set to a true value. It allows the tests to determine if they +are being executed through the harness or by any other means. + +=item C<HARNESS_VERSION> + +This is the version of Test::Harness. + +=back + +=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS + +=over 4 =item C<HARNESS_COLUMNS> diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index 6d87f4a062..db494a3c94 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,51 @@ Revision history for Perl extension Test::Harness +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. diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index c74e47191e..a2b388b6d1 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -1,23 +1,19 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $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.20_01'; +$VERSION = '0.23'; +use Config; use Test::Harness::Assert; use Test::Harness::Iterator; +use Test::Harness::Point; # Flags used as return values from our methods. Just for internal # clarification. -my $TRUE = (1==1); -my $FALSE = !$TRUE; -my $YES = $TRUE; -my $NO = $FALSE; - +my $YES = (1==1); +my $NO = !$YES; =head1 NAME @@ -58,9 +54,9 @@ The interface is currently incomplete. I<Please> contact the author if you'd like a feature added or something change or just have comments. -=head1 Construction +=head1 CONSTRUCTION -=head2 C<new> +=head2 new() my $strap = Test::Harness::Straps->new; @@ -70,14 +66,14 @@ Initialize a new strap. sub new { my $class = shift; + my $self = bless {}, $class; - my $self = bless {}, $class; $self->_init; return $self; } -=head2 C<_init> +=head2 $strap->_init $strap->_init; @@ -93,11 +89,11 @@ sub _init { $self->{_is_macos} = ( $^O eq 'MacOS' ); } -=head1 Analysis +=head1 ANALYSIS =head2 $strap->analyze( $name, \@output_lines ) - my %results = $strap->analyze($name, \@test_output); + my %results = $strap->analyze($name, \@test_output); Analyzes the output of a single test, assigning it the given C<$name> for use in the total report. Returns the C<%results> of the test. @@ -153,93 +149,102 @@ sub _analyze_iterator { sub _analyze_line { - my($self, $line, $totals) = @_; - - my %result = (); + my $self = shift; + my $line = shift; + my $totals = shift; $self->{line}++; - my $type; - if ( $self->_is_test($line, \%result) ) { - $type = 'test'; + my $linetype; + my $point = Test::Harness::Point->from_test_line( $line ); + if ( $point ) { + $linetype = 'test'; $totals->{seen}++; - $result{number} = $self->{'next'} unless $result{number}; + $point->set_number( $self->{'next'} ) unless $point->number; # sometimes the 'not ' and the 'ok' are on different lines, # happens often on VMS if you do: # print "not " unless $test; # print "ok $num\n"; - if( $self->{saw_lone_not} && - ($self->{lone_not_line} == $self->{line} - 1) ) - { - $result{ok} = 0; + if ( $self->{lone_not_line} && ($self->{lone_not_line} == $self->{line} - 1) ) { + $point->set_ok( 0 ); } - my $pass = $result{ok}; - $result{type} = 'todo' if $self->{todo}{$result{number}}; + if ( $self->{todo}{$point->number} ) { + $point->set_directive_type( 'todo' ); + } - if( $result{type} eq 'todo' ) { + if ( $point->is_todo ) { $totals->{todo}++; - $pass = 1; - $totals->{bonus}++ if $result{ok} + $totals->{bonus}++ if $point->ok; } - elsif( $result{type} eq 'skip' ) { + elsif ( $point->is_skip ) { $totals->{skip}++; - $pass = 1; } - $totals->{ok}++ if $pass; + $totals->{ok}++ if $point->pass; - if( $result{number} > 100000 && $result{number} > $self->{max} ) { - warn "Enormous test number seen [test $result{number}]\n"; + if ( ($point->number > 100000) && ($point->number > $self->{max}) ) { + warn "Enormous test number seen [test ", $point->number, "]\n"; warn "Can't detailize, too big.\n"; } else { - #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} + ok => $point->pass, + actual_ok => $point->ok, + name => _def_or_blank( $point->description ), + type => _def_or_blank( $point->directive_type ), + reason => _def_or_blank( $point->directive_reason ), }; assert( defined( $details->{ok} ) && defined( $details->{actual_ok} ) ); - - # 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; + $totals->{details}[$point->number - 1] = $details; } - - # XXX handle counter mismatch + } # test point + elsif ( $line =~ /^not\s+$/ ) { + $linetype = 'other'; + # Sometimes the "not " and "ok" will be on separate lines on VMS. + # We catch this and remember we saw it. + $self->{lone_not_line} = $self->{line}; } elsif ( $self->_is_header($line) ) { - $type = 'header'; + $linetype = 'header'; $self->{saw_header}++; $totals->{max} += $self->{max}; } elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) { - $type = 'bailout'; + $linetype = 'bailout'; $self->{saw_bailout} = 1; } + elsif (my $diagnostics = $self->_is_diagnostic_line( $line )) { + $linetype = 'other'; + my $test = $totals->{details}[-1]; + $test->{diagnostics} ||= ''; + $test->{diagnostics} .= $diagnostics; + } else { - $type = 'other'; + $linetype = 'other'; } - $self->{callback}->($self, $line, $type, $totals) if $self->{callback}; + $self->{callback}->($self, $line, $linetype, $totals) if $self->{callback}; - $self->{'next'} = $result{number} + 1 if $type eq 'test'; + $self->{'next'} = $point->number + 1 if $point; +} # _analyze_line + + +sub _is_diagnostic_line { + my ($self, $line) = @_; + return if index( $line, '# Looks like you failed' ) == 0; + $line =~ s/^#\s//; + return $line; } -=head2 C<analyze_fh> +=head2 $strap->analyze_fh( $name, $test_filehandle ) - my %results = $strap->analyze_fh($name, $test_filehandle); + my %results = $strap->analyze_fh($name, $test_filehandle); Like C<analyze>, but it reads from the given filehandle. @@ -252,9 +257,9 @@ sub analyze_fh { return $self->_analyze_iterator($name, $it); } -=head2 C<analyze_file> +=head2 $strap->analyze_file( $test_file ) - my %results = $strap->analyze_file($test_file); + my %results = $strap->analyze_file($test_file); Like C<analyze>, but it runs the given C<$test_file> and parses its results. It will also use that name for the total report. @@ -282,13 +287,14 @@ sub analyze_file { # *sigh* this breaks under taint, but open -| is unportable. my $line = $self->_command_line($file); - unless( open(FILE, "$line|") ) { + + unless ( open(FILE, "$line|" )) { print "can't run $file. $!\n"; return; } my %results = $self->analyze_fh($file, \*FILE); - my $exit = close FILE; + my $exit = close FILE; $results{'wait'} = $?; if( $? && $self->{_is_vms} ) { eval q{use vmsish "status"; $results{'exit'} = $?}; @@ -312,9 +318,7 @@ else { *_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) } } -=head2 C<_command_line( $file )> - - my $command_line = $self->_command_line(); +=head2 $strap->_command_line( $file ) Returns the full command line that will be run to test I<$file>. @@ -334,14 +338,12 @@ sub _command_line { } -=head2 C<_command> +=head2 $strap->_command() - my $command = $self->_command(); - -Returns the command that runs the test. Combine this with _switches() +Returns the command that runs the test. Combine this with C<_switches()> to build a command line. -Typically this is C<$^X>, but you can set C<$ENV{HARNESS_COMMAND}> +Typically this is C<$^X>, but you can set C<$ENV{HARNESS_PERL}> to use a different Perl than what you're running the harness under. This might be to run a threaded Perl, for example. @@ -360,9 +362,7 @@ sub _command { } -=head2 C<_switches> - - my $switches = $self->_switches($file); +=head2 $strap->_switches( $file ) Formats and returns the switches necessary to run the test. @@ -399,9 +399,7 @@ sub _switches { return join( " ", @existing_switches, @derived_switches ); } -=head2 C<_cleaned_switches> - - my @switches = $self->_cleaned_switches( @switches_from_user ); +=head2 $strap->_cleaned_switches( @switches_from_user ) Returns only defined, non-blank, trimmed switches from the parms passed. @@ -424,7 +422,7 @@ sub _cleaned_switches { return @switches; } -=head2 C<_INC2PERL5LIB> +=head2 $strap->_INC2PERL5LIB local $ENV{PERL5LIB} = $self->_INC2PERL5LIB; @@ -441,7 +439,7 @@ sub _INC2PERL5LIB { return join $Config{path_sep}, $self->_filtered_INC; } -=head2 C<_filtered_INC> +=head2 $strap->_filtered_INC() my @filtered_inc = $self->_filtered_INC; @@ -483,7 +481,7 @@ sub _default_inc { } -=head2 C<_restore_PERL5LIB> +=head2 $strap->_restore_PERL5LIB() $self->_restore_PERL5LIB; @@ -506,16 +504,16 @@ sub _restore_PERL5LIB { Methods for identifying what sort of line you're looking at. -=head2 C<_is_comment> +=head2 C<_is_diagnostic> - my $is_comment = $strap->_is_comment($line, \$comment); + my $is_diagnostic = $strap->_is_diagnostic($line, \$comment); Checks if the given line is a comment. If so, it will place it into C<$comment> (sans #). =cut -sub _is_comment { +sub _is_diagnostic { my($self, $line, $comment) = @_; if( $line =~ /^\s*\#(.*)/ ) { @@ -571,67 +569,6 @@ sub _is_header { } } -=head2 C<_is_test> - - my $is_test = $strap->_is_test($line, \%test); - -Checks if the $line is a test report (ie. 'ok/not ok'). Reports the -result back in C<%test> which will contain: - - ok did it succeed? This is the literal 'ok' or 'not ok'. - name name of the test (if any) - number test number (if any) - - type 'todo' or 'skip' (if any) - reason why is it todo or skip? (if any) - -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 - -my $Report_Re = <<'REGEX'; - ^ - (not\ )? # failure? - ok\b - (?:\s+(\d+))? # optional test number - \s* - (.*) # and the rest -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 ) { - ($test->{name}, my $control) = $extra ? split(/(?:[^\\]|^)#/, $extra) : (); - (my $type, $test->{reason}) = $control ? $control =~ /^\s*(\S+)(?:\s+(.*))?$/ : (); - - $test->{number} = $num; - $test->{ok} = $not ? 0 : 1; - - if( defined $type ) { - $test->{type} = $type =~ /^TODO$/i ? 'todo' : - $type =~ /^Skip/i ? 'skip' : 0; - } - else { - $test->{type} = ''; - } - - return $YES; - } - else{ - # Sometimes the "not " and "ok" will be on separate lines on VMS. - # We catch this and remember we saw it. - if( $line =~ /^not\s+$/ ) { - $self->{saw_lone_not} = 1; - $self->{lone_not_line} = $self->{line}; - } - - return $NO; - } -} - =head2 C<_is_bail_out> my $is_bail_out = $strap->_is_bail_out($line, \$reason); @@ -669,7 +606,6 @@ sub _reset_file_state { $self->{line} = 0; $self->{saw_header} = 0; $self->{saw_bailout}= 0; - $self->{saw_lone_not} = 0; $self->{lone_not_line} = 0; $self->{bailout_reason} = ''; $self->{'next'} = 1; @@ -709,11 +645,12 @@ There is one final item, the details. each test looks like this: $results{details}[$test_num - 1] = - { ok => is the test considered ok? - actual_ok => did it literally say 'ok'? - name => name of the test (if any) - type => 'skip' or 'todo' (if any) - reason => reason for the above (if any) + { ok => is the test considered ok? + actual_ok => did it literally say 'ok'? + name => name of the test (if any) + diagnostics => test diagnostics (if any) + type => 'skip' or 'todo' (if any) + reason => reason for the above (if any) }; Element 0 of the details is test #1. I tried it with element 1 being @@ -734,4 +671,9 @@ L<Test::Harness> =cut +sub _def_or_blank { + return $_[0] if defined $_[0]; + return ""; +} + 1; diff --git a/lib/Test/Harness/TAP.pod b/lib/Test/Harness/TAP.pod index b968aa865a..15b51b8725 100644 --- a/lib/Test/Harness/TAP.pod +++ b/lib/Test/Harness/TAP.pod @@ -4,166 +4,356 @@ 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. +TAP, the Test Anything Protocol, is Perl's simple text-based interface +between testing modules such as Test::More and the test harness +Test::Harness. -=head1 TERMINOLOGY +=head1 TODO -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. +Exit code of the process. =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. +TAP's general format is: -After all tests have been performed, runtests() prints some performance -statistics that are computed by the Benchmark module. + 1..N + ok 1 Description # Directive + # Diagnostic + .... + ok 47 Description + ok 48 Description + more tests.... -=head2 The test script output +For example, a test file's output might look like: -The following explains how Test::Harness interprets the output of your -test program. + 1..4 + ok 1 - Input file opened + not ok 2 - First line of the input valid + ok 3 - Read the rest of the file + not ok 4 - Summarized correctly # TODO Not written yet -=over 4 +=head1 HARNESS BEHAVIOR + +In this document, the "harness" is any program analyzing TAP output. +Typically this will be Perl's I<prove> program, or the underlying +C<Test::Harness::runtests> subroutine. + +A harness must only read TAP output from standard output and not +from standard error. Lines written to standard output matching +C</^(not )?ok\b/> must be interpreted as test lines. All other +lines must not be considered test output. -=item B<"1..M"> +=head1 TESTS LINES AND THE PLAN -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. +=head2 The plan -It should be the first non-comment line output by your test program. +The plan tells how many tests will be run, or how many tests have +run. It's a check that the test file hasn't stopped prematurely. +It must appear once, whether at the beginning or end of the output. -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). +The plan is usually the first line of TAP output and it specifies how +many test points are to follow. For example, -Under no circumstances should C<1..M> appear in the middle of your -output or more than once. + 1..10 -=item B<'ok', 'not ok'. Ok?> +means you plan on running 10 tests. This is a safeguard in case your test +file dies silently in the middle of its run. The plan is optional but if +there is a plan before the test points it must be the first non-diagnostic +line output by the test file. -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. +In certain instances a test file may not know how many test points +it will ultimately be running. In this case the plan can be the last +non-diagnostic line in the output. -C</^not ok/> indicates a failed test. C</^ok/> is a successful test. +The plan cannot appear in the middle of the output, nor can it appear more +than once. -=item B<test numbers> +=head2 The test line + +The core of TAP is the test line. A test file prints one test line test +point executed. There must be at least one test line in TAP output. Each +test line comprises the following elements: + +=over 4 -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 +=item * C<ok> or C<not ok> + +This tells whether the test point passed or failed. It must be +at the beginning of the line. C</^not ok/> indicates a failed test +point. C</^ok/> is a successful test point. This is the only mandatory +part of the line. + +Note that unlike the Directives below, C<ok> and C<not ok> are +case-sensitive. + +=item * Test number + +TAP expects the C<ok> or C<not ok> to be followed by a test point +number. If there is no number the harness must maintain +its own counter until the script supplies test numbers again. So +the following test output - print <<END; 1..6 not ok ok not ok ok ok - END -will generate +has five tests. The sixth is missing. Test::Harness will generate FAILED tests 1, 3, 6 Failed 3/6 tests, 50.00% okay -=item B<test labels> +=item * Description + +Any text after the test number but before a C<#> is the description of +the test point. -Anything after the test number, but before the "#", is considered -to be the label for the test. + ok 42 this is the description of the test - ok 42 this is the label of the test +Descriptions should not begin with a digit so that they are not confused +with the test point number. -Currently, Test::Harness does nothing with this information. +The harness may do whatever it wants with the description. -=item B<Skipping tests> +=item * Directive -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. +The test point may include a directive, following a hash on the +test line. There are currently two directives allowed: C<TODO> and +C<SKIP>. These are discussed below. - ok 23 # skip Insufficient flogiston pressure. +=back + +To summarize: + +=over 4 + +=item * ok/not ok (required) + +=item * Test number (recommended) + +=item * Description (recommended) + +=item * Directive (only when necessary) + +=back -Similarly, one can include a similar explanation in a C<1..0> line -emitted if the test script is skipped completely: +=head1 DIRECTIVES - 1..0 # Skipped: no leverage found +Directives are special notes that follow a C<#> on the test line. +Only two are currently defined: C<TODO> and C<SKIP>. Note that +these two keywords are not case-sensitive. -=item B<Todo tests> +=head2 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. +If the directive starts with C<# TODO>, the test is counted as a +todo test, and the text after C<TODO> is the the explanation. - not ok 13 # TODO harness the power of the atom + not ok 13 # TODO bend space and time -Note that the TODO must have a space after it. +Note that if the TODO has an explanation it must be separated from +C<TODO> by a space. These tests represent a feature to be implemented or a bug to be fixed -and act as something of an executable "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 +and act as something of an executable "things to do" list. They are +B<not> expected to succeed. Should a todo test point begin succeeding, +the harness should report it as a bonus. This indicates that whatever you were supposed to do has been done and you should promote this to a -normal test. +normal test point. -=item B<Bail out!> +=head2 Skipping tests -As an emergency measure, a test script can decide that further tests +If the directive starts with C<# SKIP>, the test is counted as having +been skipped. If the whole test file succeeds, the count of skipped +tests is included in the generated output. The harness should report +the text after C< # SKIP\S*\s+> as a reason for skipping. + + ok 23 # skip Insufficient flogiston pressure. + +Similarly, one can include an explanation in a plan line, +emitted if the test file is skipped completely: + + 1..0 # Skipped: WWW::Mechanize not installed + +=head1 OTHER LINES + +=head2 Bail out! + +As an emergency measure a test script can decide that further tests are useless (e.g. missing dependencies) and testing should stop immediately. In that case the test script prints the magic words - Bail out! + Bail out! to standard output. Any message after these words must be displayed -by the interpreter as the reason why testing must be stopped. +by the interpreter as the reason why testing must be stopped, as +in -=item B<Comments> + Bail out! MySQL is not running. -Additional comments may be put into the testing output on their own -lines. Comment lines should begin with a '#', Test::Harness will -ignore them. +=head2 Diagnostics - ok 1 - # Life is good, the sun is shining, RAM is cheap. - not ok 2 - # got 'Bush' expected 'Gore' +Additional information may be put into the testing output on separate +lines. Diagnostic lines should begin with a C<#>, which the harness must +ignore, at least as far as analyzing the test results. The harness is +free, however, to display the diagnostics. Typically diagnostics are +used to provide information about the environment in which test file is +running, or to delineate a group of tests. + ... + ok 18 - Closed database connection + # End of database section. + # This starts the network part of the test. + # Daemon started on port 2112 + ok 19 - Opened socket + ... + ok 47 - Closed socket + # End of network tests -=item B<Anything else> +=head2 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. +Any output line that is not a plan, a test line or a diagnostic is +incorrect. How a harness handles the incorrect line is undefined. +Test::Harness silently ignores incorrect lines, but will become more +stringent in the future. -=back +=head1 EXAMPLES -=head1 DESCRIPTION +All names, places, and events depicted in any example are wholly +fictitious and bear no resemblance to, connection with, or relation to any +real entity. Any such similarity is purely coincidental, unintentional, +and unintended. -=head1 RATIONALE +=head2 Common with explanation -=head1 ACKNOWLEDGEMENTS +The following TAP listing declares that six tests follow as well as +provides handy feedback as to what the test is about to do. All six +tests pass. + + 1..6 + # + # Create a new Board and Tile, then place + # the Tile onto the board. + # + ok 1 - The object isa Board + ok 2 - Board size is zero + ok 3 - The object isa Tile + ok 4 - Get possible places to put the Tile + ok 5 - Placing the tile produces no error + ok 6 - Board size is 1 + +=head2 Unknown amount and failures + +This hypothetical test program ensures that a handful of servers are +online and network-accessible. Because it retrieves the hypothetical +servers from a database, it doesn't know exactly how many servers it +will need to ping. Thus, the test count is declared at the bottom after +all the test points have run. Also, two of the tests fail. + + ok 1 - retrieving servers from the database + # need to ping 6 servers + ok 2 - pinged diamond + ok 3 - pinged ruby + not ok 4 - pinged saphire + ok 5 - pinged onyx + not ok 6 - pinged quartz + ok 7 - pinged gold + 1..7 + +=head2 Giving up + +This listing reports that a pile of tests are going to be run. However, +the first test fails, reportedly because a connection to the database +could not be established. The program decided that continuing was +pointless and exited. + + 1..573 + not ok 1 - database handle + Bail out! Couldn't connect to database. + +=head2 Skipping a few + +The following listing plans on running 5 tests. However, our program +decided to not run tests 2 thru 5 at all. To properly report this, +the tests are marked as being skipped. + + 1..5 + ok 1 - approved operating system + # $^0 is solaris + ok 2 - # SKIP no /sys directory + ok 3 - # SKIP no /sys directory + ok 4 - # SKIP no /sys directory + ok 5 - # SKIP no /sys directory + +=head2 Skipping everything + +This listing shows that the entire listing is a skip. No tests were run. + + 1..0 # skip because English-to-French translator isn't installed + +=head2 Got spare tuits? + +The following example reports that four tests are run and the last two +tests failed. However, becauses the failing tests are marked as things +to do later, they are considered successes. Thus, a harness should report +this entire listing as a success. + + 1..4 + ok 1 - Creating test program + ok 2 - Test program runs, no error + not ok 3 - infinite loop # TODO halting problem unsolved + not ok 4 - infinite loop 2 # TODO halting problem unsolved + +=head2 Creative liberties + +This listing shows an alternate output where the test numbers aren't +provided. The test also reports the state of a ficticious board game in +diagnostic form. Finally, the test count is reported at the end. + + ok - created Board + ok + ok + ok + ok + ok + ok + ok + # +------+------+------+------+ + # | |16G | |05C | + # | |G N C | |C C G | + # | | G | | C +| + # +------+------+------+------+ + # |10C |01G | |03C | + # |R N G |G A G | |C C C | + # | R | G | | C +| + # +------+------+------+------+ + # | |01G |17C |00C | + # | |G A G |G N R |R N R | + # | | G | R | G | + # +------+------+------+------+ + ok - board has 7 tiles + starter tile + 1..9 =head1 AUTHORS Andy Lester, based on the original Test::Harness documentation by Michael Schwern. +=head1 ACKNOWLEDGEMENTS + +Thanks to +Pete Krawczyk, +Paul Johnson, +Ian Langworth +and Nik Clayton +for help and contributions on this document. + +The basis for the TAP format was created by Larry Wall in the +original test script for Perl 1. Tim Bunce and Andreas Koenig +developed it further with their modifications to Test::Harness. + =head1 COPYRIGHT -Copyright 2003-2004 by +Copyright 2003-2005 by Michael G Schwern C<< <schwern@pobox.com> >>, Andy Lester C<< <andy@petdance.com> >>. diff --git a/lib/Test/Harness/t/00compile.t b/lib/Test/Harness/t/00compile.t index 5c333b30d1..ad4ddde508 100644 --- a/lib/Test/Harness/t/00compile.t +++ b/lib/Test/Harness/t/00compile.t @@ -10,10 +10,10 @@ BEGIN { } } -use Test::More tests => 5; +use Test::More tests => 6; BEGIN { use_ok 'Test::Harness' } -BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION" ) unless $ENV{PERL_CORE}} +BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION under Perl $] and Test::More $Test::More::VERSION" ) unless $ENV{PERL_CORE}} BEGIN { use_ok 'Test::Harness::Straps' } @@ -21,6 +21,8 @@ BEGIN { use_ok 'Test::Harness::Iterator' } BEGIN { use_ok 'Test::Harness::Assert' } +BEGIN { use_ok 'Test::Harness::Point' } + # If the $VERSION is set improperly, this will spew big warnings. BEGIN { use_ok 'Test::Harness', 1.1601 } diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index ed27fcd019..e322df424d 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -30,436 +30,520 @@ my $die_exit = $IsVMS ? 44 : 1; my $wait_non_zero = 1; my %samples = ( - combined => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 10, - seen => 10, - - 'ok' => 8, - 'todo' => 2, - 'skip' => 1, - bonus => 1, - - details => [ { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1, - name => 'basset hounds got long ears', - }, - { 'ok' => 0, actual_ok => 0, - name => 'all hell broke lose', - }, - { 'ok' => 1, actual_ok => 1, - type => 'todo' - }, - { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1, - type => 'skip', - reason => 'contract negociations' - }, - { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 0, actual_ok => 0 }, - { 'ok' => 1, actual_ok => 0, - type => 'todo' - }, - ] - }, - - descriptive => { - passing => 1, - - 'wait' => 0, - 'exit' => 0, - - max => 5, - seen => 5, - - 'ok' => 5, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1, - name => 'Interlock activated' - }, - { 'ok' => 1, actual_ok => 1, - name => 'Megathrusters are go', - }, - { 'ok' => 1, actual_ok => 1, - name => 'Head formed', - }, - { 'ok' => 1, actual_ok => 1, - name => 'Blazing sword formed' - }, - { 'ok' => 1, actual_ok => 1, - name => 'Robeast destroyed' - }, - ], - }, - - duplicates => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 10, - seen => 11, - - 'ok' => 11, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 10 - ], - }, - - head_end => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 4, - seen => 4, - - 'ok' => 4, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 - ], - }, - - lone_not_bug => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 4, - seen => 4, - - 'ok' => 4, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 - ], - }, - - head_fail => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 4, - seen => 4, - - 'ok' => 3, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 0, actual_ok => 0 }, - ({ 'ok'=> 1, actual_ok => 1 }) x 2 - ], - }, - - no_output => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 0, - seen => 0, - - 'ok' => 0, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [], - }, - - simple => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 5, - seen => 5, - - 'ok' => 5, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 5 - ] - }, - - simple_fail => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 5, - seen => 5, - - 'ok' => 3, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 0, actual_ok => 0 }, - { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 0, actual_ok => 0 }, - ] - }, - - 'skip' => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 5, - seen => 5, - - 'ok' => 5, - 'todo' => 0, - 'skip' => 1, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1, - type => 'skip', - reason => 'rain delay', - }, - ({ 'ok' => 1, actual_ok => 1 }) x 3 - ] - }, - - 'skip_nomsg' => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 1, - seen => 1, - - 'ok' => 1, - 'todo' => 0, - 'skip' => 1, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1, - type => 'skip', - reason => '', - }, - ] - }, - - skipall => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 0, - seen => 0, - skip_all => 'rope', - - 'ok' => 0, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [], - }, - - skipall_nomsg => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 0, - seen => 0, - skip_all => '', - - 'ok' => 0, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [], - }, - - 'todo' => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 5, - seen => 5, - - 'ok' => 5, - 'todo' => 2, - 'skip' => 0, - bonus => 1, - - details => [ { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1, - type => 'todo' }, - { 'ok' => 1, actual_ok => 0, - type => 'todo' }, - ({ 'ok' => 1, actual_ok => 1 }) x 2 - ], - }, - taint => { - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 1, - seen => 1, - - 'ok' => 1, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1, - name => '- -T honored' - }, - ], - }, - vms_nit => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 2, - seen => 2, - - 'ok' => 1, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ { 'ok' => 0, actual_ok => 0 }, - { 'ok' => 1, actual_ok => 1 }, - ], - }, - 'die' => { - passing => 0, - - 'exit' => $die_exit, - 'wait' => $wait_non_zero, - - max => 0, - seen => 0, - - 'ok' => 0, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [] - }, - - die_head_end => { - passing => 0, - - 'exit' => $die_exit, - 'wait' => $wait_non_zero, - - max => 0, - seen => 4, - - 'ok' => 4, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 - ], - }, - - die_last_minute => { - passing => 0, - - 'exit' => $die_exit, - 'wait' => $wait_non_zero, - - max => 4, - seen => 4, - - 'ok' => 4, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 - ], - }, - - bignum => { - passing => 0, - - 'exit' => 0, - 'wait' => 0, - - max => 2, - seen => 4, - - 'ok' => 4, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ { 'ok' => 1, actual_ok => 1 }, - { 'ok' => 1, actual_ok => 1 }, - ] - }, - - 'shbang_misparse' =>{ - passing => 1, - - 'exit' => 0, - 'wait' => 0, - - max => 2, - seen => 2, - - 'ok' => 2, - 'todo' => 0, - 'skip' => 0, - bonus => 0, - - details => [ ({ 'ok' => 1, actual_ok => 1 }) x 2 ] - }, + bignum => { + bonus => 0, + details => [ + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + ok => 1 + } + ], + 'exit' => 0, + max => 2, + ok => 4, + passing => 0, + seen => 4, + skip => 0, + todo => 0, + 'wait' => 0 + }, + combined => { + bonus => 1, + details => [ + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + name => "basset hounds got long ears", + ok => 1 + }, + { + actual_ok => 0, + name => "all hell broke lose", + ok => 0 + }, + { + actual_ok => 1, + ok => 1, + type => "todo" + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + ok => 1, + reason => "contract negociations", + type => "skip" + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 0, + ok => 0 + }, + { + actual_ok => 0, + ok => 1, + type => "todo" + } + ], + 'exit' => 0, + max => 10, + ok => 8, + passing => 0, + seen => 10, + skip => 1, + todo => 2, + 'wait' => 0 + }, + descriptive => { + bonus => 0, + details => [ + { + actual_ok => 1, + name => "Interlock activated", + ok => 1 + }, + { + actual_ok => 1, + name => "Megathrusters are go", + ok => 1 + }, + { + actual_ok => 1, + name => "Head formed", + ok => 1 + }, + { + actual_ok => 1, + name => "Blazing sword formed", + ok => 1 + }, + { + actual_ok => 1, + name => "Robeast destroyed", + ok => 1 + } + ], + 'exit' => 0, + max => 5, + ok => 5, + passing => 1, + seen => 5, + skip => 0, + todo => 0, + 'wait' => 0 + }, + 'die' => { + bonus => 0, + details => [], + 'exit' => $die_exit, + max => 0, + ok => 0, + passing => 0, + seen => 0, + skip => 0, + todo => 0, + 'wait' => $wait_non_zero + }, + die_head_end => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 4, + ], + 'exit' => $die_exit, + max => 0, + ok => 4, + passing => 0, + seen => 4, + skip => 0, + todo => 0, + 'wait' => $wait_non_zero + }, + die_last_minute => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 4, + ], + 'exit' => $die_exit, + max => 4, + ok => 4, + passing => 0, + seen => 4, + skip => 0, + todo => 0, + 'wait' => $wait_non_zero + }, + duplicates => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 10, + ], + 'exit' => 0, + max => 10, + ok => 11, + passing => 0, + seen => 11, + skip => 0, + todo => 0, + 'wait' => 0 + }, + head_end => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 3, + { + actual_ok => 1, + diagnostics => "comment\nmore ignored stuff\nand yet more\n", + ok => 1 + } + ], + 'exit' => 0, + max => 4, + ok => 4, + passing => 1, + seen => 4, + skip => 0, + todo => 0, + 'wait' => 0 + }, + head_fail => { + bonus => 0, + details => [ + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 0, + ok => 0 + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + diagnostics => "comment\nmore ignored stuff\nand yet more\n", + ok => 1 + } + ], + 'exit' => 0, + max => 4, + ok => 3, + passing => 0, + seen => 4, + skip => 0, + todo => 0, + 'wait' => 0 + }, + lone_not_bug => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 4, + ], + 'exit' => 0, + max => 4, + ok => 4, + passing => 1, + seen => 4, + skip => 0, + todo => 0, + 'wait' => 0 + }, + no_output => { + bonus => 0, + details => [], + 'exit' => 0, + max => 0, + ok => 0, + passing => 0, + seen => 0, + skip => 0, + todo => 0, + 'wait' => 0 + }, + shbang_misparse => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 2, + ], + 'exit' => 0, + max => 2, + ok => 2, + passing => 1, + seen => 2, + skip => 0, + todo => 0, + 'wait' => 0 + }, + simple => { + bonus => 0, + details => [ + ({ + actual_ok => 1, + ok => 1 + }) x 5, + ], + 'exit' => 0, + max => 5, + ok => 5, + passing => 1, + seen => 5, + skip => 0, + todo => 0, + 'wait' => 0 + }, + simple_fail => { + bonus => 0, + details => [ + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 0, + ok => 0 + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 0, + ok => 0 + } + ], + 'exit' => 0, + max => 5, + ok => 3, + passing => 0, + seen => 5, + skip => 0, + todo => 0, + 'wait' => 0 + }, + skip => { + bonus => 0, + details => [ + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + ok => 1, + reason => "rain delay", + type => "skip" + }, + ({ + actual_ok => 1, + ok => 1 + }) x 3, + ], + 'exit' => 0, + max => 5, + ok => 5, + passing => 1, + seen => 5, + skip => 1, + todo => 0, + 'wait' => 0 + }, + skip_nomsg => { + bonus => 0, + details => [ + { + actual_ok => 1, + ok => 1, + reason => "", + type => "skip" + } + ], + 'exit' => 0, + max => 1, + ok => 1, + passing => 1, + seen => 1, + skip => 1, + todo => 0, + 'wait' => 0 + }, + skipall => { + bonus => 0, + details => [], + 'exit' => 0, + max => 0, + ok => 0, + passing => 1, + seen => 0, + skip => 0, + skip_all => "rope", + todo => 0, + 'wait' => 0 + }, + skipall_nomsg => { + bonus => 0, + details => [], + 'exit' => 0, + max => 0, + ok => 0, + passing => 1, + seen => 0, + skip => 0, + skip_all => "", + todo => 0, + 'wait' => 0 + }, + taint => { + bonus => 0, + details => [ + { + actual_ok => 1, + name => "-T honored", + ok => 1 + } + ], + 'exit' => 0, + max => 1, + ok => 1, + passing => 1, + seen => 1, + skip => 0, + todo => 0, + 'wait' => 0 + }, + todo => { + bonus => 1, + details => [ + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 1, + ok => 1, + type => "todo" + }, + { + actual_ok => 0, + ok => 1, + type => "todo" + }, + ({ + actual_ok => 1, + ok => 1 + }) x 2, + ], + 'exit' => 0, + max => 5, + ok => 5, + passing => 1, + seen => 5, + skip => 0, + todo => 2, + 'wait' => 0 + }, + vms_nit => { + bonus => 0, + details => [ + { + actual_ok => 0, + ok => 0 + }, + { + actual_ok => 1, + ok => 1 + } + ], + 'exit' => 0, + max => 2, + ok => 1, + passing => 0, + seen => 2, + skip => 0, + todo => 0, + 'wait' => 0 + }, + with_comments => { + bonus => 2, + details => [ + { + actual_ok => 0, + diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n", + ok => 1, + type => "todo" + }, + { + actual_ok => 1, + ok => 1, + reason => "at line 10 TODO?!)", + type => "todo" + }, + { + actual_ok => 1, + ok => 1 + }, + { + actual_ok => 0, + diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n", + ok => 1, + type => "todo" + }, + { + actual_ok => 1, + diagnostics => "woo\n", + ok => 1, + reason => "at line 13 TODO?!)", + type => "todo" + } + ], + 'exit' => 0, + max => 5, + ok => 5, + passing => 1, + seen => 5, + skip => 0, + todo => 4, + 'wait' => 0 + }, ); - plan tests => (keys(%samples) * 5) + 3; use Test::Harness::Straps; @@ -470,15 +554,13 @@ $SIG{__WARN__} = sub { }; for my $test ( sort keys %samples ) { + print "# Working on $test\n"; my $expect = $samples{$test}; - for (0..$#{$expect->{details}}) { - $expect->{details}[$_]{type} = '' - unless exists $expect->{details}[$_]{type}; - $expect->{details}[$_]{name} = '' - unless exists $expect->{details}[$_]{name}; - $expect->{details}[$_]{reason} = '' - unless exists $expect->{details}[$_]{reason}; + for my $n ( 0..$#{$expect->{details}} ) { + for my $field ( qw( type name reason ) ) { + $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field}; + } } my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); @@ -486,7 +568,7 @@ for my $test ( sort keys %samples ) { isa_ok( $strap, 'Test::Harness::Straps' ); my %results = $strap->analyze_file($test_path); - is_deeply($results{details}, $expect->{details}, "$test details" ); + is_deeply($results{details}, $expect->{details}, qq{details of "$test"} ); delete $expect->{details}; delete $results{details}; @@ -506,7 +588,7 @@ for my $test ( sort keys %samples ) { delete $expect->{'exit'}; } - is_deeply(\%results, $expect, " the rest $test" ); + is_deeply(\%results, $expect, qq{ the rest of "$test"} ); } # for %samples NON_EXISTENT_FILE: { diff --git a/lib/Test/Harness/t/strap.t b/lib/Test/Harness/t/strap.t index f1cba106c6..0af6065697 100644 --- a/lib/Test/Harness/t/strap.t +++ b/lib/Test/Harness/t/strap.t @@ -12,20 +12,20 @@ BEGIN { use strict; -use Test::More tests => 176; +use Test::More tests => 89; BEGIN { use_ok('Test::Harness::Straps'); } my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps', 'new()' ); -### Testing _is_comment() +### Testing _is_diagnostic() my $comment; -ok( !$strap->_is_comment("foo", \$comment), '_is_comment(), not a comment' ); +ok( !$strap->_is_diagnostic("foo", \$comment), '_is_diagnostic(), not a comment' ); ok( !defined $comment, ' no comment set' ); -ok( !$strap->_is_comment("f # oo", \$comment), ' not a comment with #' ); +ok( !$strap->_is_diagnostic("f # oo", \$comment), ' not a comment with #' ); ok( !defined $comment, ' no comment set' ); my %comments = ( @@ -41,7 +41,7 @@ for my $line ( sort keys %comments ) { isa_ok( $strap, 'Test::Harness::Straps' ); my $name = substr($line, 0, 20); - ok( $strap->_is_comment($line, \$comment), " comment '$name'" ); + ok( $strap->_is_diagnostic($line, \$comment), " comment '$name'" ); is( $comment, $line_comment, ' right comment set' ); } @@ -120,85 +120,6 @@ for my $header ( sort keys %headers ) { -### Testing _is_test() - -my %tests = ( - 'ok' => { 'ok' => 1 }, - 'not ok' => { 'ok' => 0 }, - - 'ok 1' => { 'ok' => 1, number => 1 }, - 'not ok 1' => { 'ok' => 0, number => 1 }, - - 'ok 2938' => { 'ok' => 1, number => 2938 }, - - 'ok 1066 - and all that' => { 'ok' => 1, - number => 1066, - name => "- and all that" }, - 'not ok 42 - universal constant' => - { 'ok' => 0, - number => 42, - name => '- universal constant', - }, - 'not ok 23 # TODO world peace' => { 'ok' => 0, - number => 23, - type => 'todo', - reason => 'world peace' - }, - 'ok 11 - have life # TODO get a life' => - { 'ok' => 1, - number => 11, - name => '- have life', - type => 'todo', - reason => 'get a life' - }, - 'not ok # TODO' => { 'ok' => 0, - type => 'todo', - reason => '' - }, - 'ok # skip' => { 'ok' => 1, - type => 'skip', - }, - 'not ok 11 - this is \# all the name # skip this is not' - => { 'ok' => 0, - number => 11, - name => '- this is \# all the name', - type => 'skip', - reason => 'this is not' - }, - "ok 42 - _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because" - => { 'ok' => 1, - number => 42, - name => "- _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because", - }, - ); - -for my $line ( sort keys %tests ) { - my $expect = $tests{$line}; - my %test; - ok( $strap->_is_test($line, \%test), "_is_test() spots '$line'" ); - - foreach my $type (qw(ok number name type reason)) { - cmp_ok( $test{$type}, 'eq', $expect->{$type}, " $type" ); - } -} - -my @untests = ( - ' ok', - 'not', - 'okay 23', - ); -foreach my $line (@untests) { - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - - my %test = (); - ok( !$strap->_is_test($line, \%test), "_is_test() disregards '$line'" ); - - # is( keys %test, 0 ) won't work in 5.004 because it's undef. - ok( !keys %test, ' and produces no test info' ); -} - - ### Test _is_bail_out() my %bails = ( |