From: Steve Peters Date: Sat, 7 Oct 2006 01:34:15 +0000 (+0000) Subject: Upgrade to Test-Harness-2.64 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b1ebecd6d20d472272a372288570616cb63b531;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Test-Harness-2.64 p4raw-id: //depot/perl@28953 --- diff --git a/MANIFEST b/MANIFEST index 83fce2d..aeadf96 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2371,6 +2371,7 @@ lib/Test/Harness/Changes Test::Harness lib/Test/Harness/Iterator.pm Test::Harness::Iterator (internal use only) lib/Test/Harness.pm A test harness lib/Test/Harness/Point.pm Test::Harness::Point (internal use only) +lib/Test/Harness/Results.pm object for tracking results from a single test file lib/Test/Harness/Straps.pm Test::Harness::Straps lib/Test/Harness/t/00compile.t Test::Harness test lib/Test/Harness/TAP.pod Documentation for the Test Anything Protocol diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 6e8236d..1991a60 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -24,7 +24,7 @@ use vars qw( ); BEGIN { - eval "use Time::HiRes 'time'"; + eval q{use Time::HiRes 'time'}; $has_time_hires = !$@; } @@ -34,11 +34,11 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 2.62 +Version 2.64 =cut -$VERSION = '2.62'; +$VERSION = '2.64'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; @@ -56,7 +56,37 @@ END { my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR}; -$Strap = Test::Harness::Straps->new; +# Stolen from Params::Util +sub _CLASS { + (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s) ? $_[0] : undef; +} + +# Strap Overloading +if ( $ENV{HARNESS_STRAPS_CLASS} ) { + die 'Set HARNESS_STRAP_CLASS, singular, not HARNESS_STRAPS_CLASS'; +} +my $HARNESS_STRAP_CLASS = $ENV{HARNESS_STRAP_CLASS} || 'Test::Harness::Straps'; +if ( $HARNESS_STRAP_CLASS =~ /\.pm$/ ) { + # "Class" is actually a filename, that should return the + # class name as its true return value. + $HARNESS_STRAP_CLASS = require $HARNESS_STRAP_CLASS; + if ( !_CLASS($HARNESS_STRAP_CLASS) ) { + die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name"; + } +} +else { + # It is a class name within the current @INC + if ( !_CLASS($HARNESS_STRAP_CLASS) ) { + die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name"; + } + eval "require $HARNESS_STRAP_CLASS"; + die $@ if $@; +} +if ( !$HARNESS_STRAP_CLASS->isa('Test::Harness::Straps') ) { + die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' must be a Test::Harness::Straps subclass"; +} + +$Strap = $HARNESS_STRAP_CLASS->new; sub strap { return $Strap }; @@ -66,7 +96,7 @@ sub strap { return $Strap }; $Verbose = $ENV{HARNESS_VERBOSE} || 0; $Debug = $ENV{HARNESS_DEBUG} || 0; -$Switches = "-w"; +$Switches = '-w'; $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; $Columns--; # Some shells have trouble with a full line of text. $Timer = $ENV{HARNESS_TIMER} || 0; @@ -333,7 +363,7 @@ sub execute_tests { print $out "# Running: ", $Strap->_command_line($tfile), "\n"; } my $test_start_time = $Timer ? time : 0; - my %results = $Strap->analyze_file($tfile) or + my $results = $Strap->analyze_file($tfile) or do { warn $Strap->{error}, "\n"; next }; my $elapsed; if ( $Timer ) { @@ -350,35 +380,36 @@ sub execute_tests { } # state of the current test. - my @failed = grep { !$results{details}[$_-1]{ok} } - 1..@{$results{details}}; - my @todo_pass = grep { $results{details}[$_-1]{actual_ok} && - $results{details}[$_-1]{type} eq 'todo' } - 1..@{$results{details}}; + my @failed = grep { !$results->details->[$_-1]{ok} } + 1..@{$results->details}; + my @todo_pass = grep { $results->details->[$_-1]{actual_ok} && + $results->details->[$_-1]{type} eq 'todo' } + 1..@{$results->details}; my %test = ( - ok => $results{ok}, - 'next' => $Strap->{'next'}, - max => $results{max}, - failed => \@failed, - todo_pass => \@todo_pass, - todo => $results{todo}, - bonus => $results{bonus}, - skipped => $results{skip}, - skip_reason => $results{skip_reason}, - skip_all => $Strap->{skip_all}, - ml => $ml, - ); - - $tot{bonus} += $results{bonus}; - $tot{max} += $results{max}; - $tot{ok} += $results{ok}; - $tot{todo} += $results{todo}; - $tot{sub_skipped} += $results{skip}; - - my($estatus, $wstatus) = @results{qw(exit wait)}; - - if ($results{passing}) { + ok => $results->ok, + 'next' => $Strap->{'next'}, + max => $results->max, + failed => \@failed, + todo_pass => \@todo_pass, + todo => $results->todo, + bonus => $results->bonus, + skipped => $results->skip, + skip_reason => $results->skip_reason, + skip_all => $Strap->{skip_all}, + ml => $ml, + ); + + $tot{bonus} += $results->bonus; + $tot{max} += $results->max; + $tot{ok} += $results->ok; + $tot{todo} += $results->todo; + $tot{sub_skipped} += $results->skip; + + my $estatus = $results->exit; + my $wstatus = $results->wait; + + if ( $results->passing ) { # XXX Combine these first two if ($test{max} and $test{skipped} + $test{bonus}) { my @msg; @@ -420,7 +451,7 @@ sub execute_tests { } # List overruns as failures. else { - my $details = $results{details}; + my $details = $results->details; foreach my $overrun ($test{max}+1..@$details) { next unless ref $details->[$overrun-1]; push @{$test{failed}}, $overrun @@ -432,7 +463,7 @@ sub execute_tests { $estatus, $wstatus); $failedtests{$tfile}{name} = $tfile; } - elsif($results{seen}) { + elsif ( $results->seen ) { if (@{$test{failed}} and $test{max}) { my ($txt, $canon) = _canondetail($test{max},$test{skipped},'Failed', @{$test{failed}}); @@ -617,12 +648,12 @@ sub swrite { my %Handlers = ( - header => \&header_handler, - test => \&test_handler, + header => \&header_handler, + test => \&test_handler, bailout => \&bailout_handler, ); -$Strap->{callback} = \&strap_callback; +$Strap->set_callback(\&strap_callback); sub strap_callback { my($self, $line, $type, $totals) = @_; print $line if $Verbose; @@ -640,30 +671,29 @@ sub header_handler { $self->{_seen_header}++; warn "1..M can only appear at the beginning or end of tests\n" - if $totals->{seen} && - $totals->{max} < $totals->{seen}; + if $totals->seen && ($totals->max < $totals->seen); }; sub test_handler { my($self, $line, $type, $totals) = @_; - my $curr = $totals->{seen}; + my $curr = $totals->seen; my $next = $self->{'next'}; - my $max = $totals->{max}; - my $detail = $totals->{details}[-1]; + my $max = $totals->max; + my $detail = $totals->details->[-1]; if( $detail->{ok} ) { _print_ml_less("ok $curr/$max"); if( $detail->{type} eq 'skip' ) { - $totals->{skip_reason} = $detail->{reason} - unless defined $totals->{skip_reason}; - $totals->{skip_reason} = 'various reasons' - if $totals->{skip_reason} ne $detail->{reason}; + $totals->set_skip_reason( $detail->{reason} ) + unless defined $totals->skip_reason; + $totals->set_skip_reason( 'various reasons' ) + if $totals->skip_reason ne $detail->{reason}; } } else { - _print_ml("NOK $curr"); + _print_ml("NOK $curr/$max"); } if( $curr > $next ) { @@ -989,6 +1019,21 @@ If true, Test::Harness will output the verbose results of running its tests. Setting C<$Test::Harness::verbose> will override this, or you can use the C<-v> switch in the F utility. +If true, Test::Harness will output the verbose results of running +its tests. Setting C<$Test::Harness::verbose> will override this, +or you can use the C<-v> switch in the F utility. + +=item C + +Defines the Test::Harness::Straps subclass to use. The value may either +be a filename or a class name. + +If HARNESS_STRAP_CLASS is a class name, the class must be in C<@INC> +like any other class. + +If HARNESS_STRAP_CLASS is a filename, the .pm file must return the name +of the class, instead of the canonical "1". + =back =head1 EXAMPLE @@ -1039,8 +1084,6 @@ Remember exit code Completely redo the print summary code. -Implement Straps callbacks. (experimentally implemented) - Straps->analyze_file() not taint clean, don't know if it can be Fix that damned VMS nit. diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index 479b82c..9be4fcd 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,26 @@ Revision history for Perl extension Test::Harness +NEXT + [FIXES] + * prove's --perl=/path/to/file wasn't taking a value. + * prove's version number was not getting incremented. From now on, + prove's $VERSION will match Test::Harness's $VERSION, and I added + a test to make sure this is the case. + + [ENHANCEMENTS] + * Added test straps overload via HARNESS_STRAP_OVERLOAD environment + variable. prove now takes a --strap=class parameter. Thanks, + Adam Kennedy. + +2.63_01 Fri Jun 30 16:59:50 CDT 2006 + [ENHANCEMENTS] + * Failed tests used to say "NOK x", and now say "NOK x/y". + Thanks to Will Coleda. + + * Added the Test::Harness::Results object, so we have a well-defined + object, and not just a hash that we pass around. Thanks to YAPC::NA + 2006 Hackathon! + 2.62 Thu Jun 8 14:11:57 CDT 2006 [FIXES] * Restored the behavior of dying if any subtests failed. This is a diff --git a/lib/Test/Harness/Results.pm b/lib/Test/Harness/Results.pm new file mode 100644 index 0000000..f972fdd --- /dev/null +++ b/lib/Test/Harness/Results.pm @@ -0,0 +1,171 @@ +# -*- Mode: cperl; cperl-indent-level: 4 -*- +package Test::Harness::Results; + +use strict; +use vars qw($VERSION); +$VERSION = '0.01'; + +=head1 NAME + +Test::Harness::Results - object for tracking results from a single test file + +=head1 SYNOPSIS + +One Test::Harness::Results object represents the results from one +test file getting analyzed. + +=head1 CONSTRUCTION + +=head2 new() + + my $results = new Test::Harness::Results; + +Create a test point object. Typically, however, you'll not create +one yourself, but access a Results object returned to you by +Test::Harness::Results. + +=cut + +sub new { + my $class = shift; + my $self = bless {}, $class; + + return $self; +} + +=head1 ACCESSORS + +The following data points are defined: + + passing true if the whole test is considered a pass + (or skipped), false if its a failure + + exit the exit code of the test run, if from a file + wait the wait code of the test run, if from a file + + max total tests which should have been run + seen total tests actually seen + skip_all if the whole test was skipped, this will + contain the reason. + + ok number of tests which passed + (including todo and skips) + + todo number of todo tests seen + bonus number of todo tests which + unexpectedly passed + + skip number of tests skipped + +So a successful test should have max == seen == ok. + + +There is one final item, the details. + + details an array ref reporting the result of + each test looks like this: + + $results{details}[$test_num - 1] = + { ok => is the test considered ok? + actual_ok => did it literally say 'ok'? + name => name of the test (if any) + diagnostics => test diagnostics (if any) + type => 'skip' or 'todo' (if any) + reason => reason for the above (if any) + }; + +Element 0 of the details is test #1. I tried it with element 1 being +#1 and 0 being empty, this is less awkward. + + +Each of the following fields has a getter and setter method. + +=over 4 + +=item * wait + +=item * exit + +=cut + +sub set_wait { my $self = shift; $self->{wait} = shift } +sub wait { + my $self = shift; + return $self->{wait} || 0; +} + +sub set_skip_all { my $self = shift; $self->{skip_all} = shift } +sub skip_all { + my $self = shift; + return $self->{skip_all}; +} + +sub inc_max { my $self = shift; $self->{max} += (@_ ? shift : 1) } +sub max { + my $self = shift; + return $self->{max} || 0; +} + +sub set_passing { my $self = shift; $self->{passing} = shift } +sub passing { + my $self = shift; + return $self->{passing} || 0; +} + +sub inc_ok { my $self = shift; $self->{ok} += (@_ ? shift : 1) } +sub ok { + my $self = shift; + return $self->{ok} || 0; +} + +sub set_exit { my $self = shift; $self->{exit} = shift } +sub exit { + my $self = shift; + return $self->{exit} || 0; +} + +sub inc_bonus { my $self = shift; $self->{bonus}++ } +sub bonus { + my $self = shift; + return $self->{bonus} || 0; +} + +sub set_skip_reason { my $self = shift; $self->{skip_reason} = shift } +sub skip_reason { + my $self = shift; + return $self->{skip_reason} || 0; +} + +sub inc_skip { my $self = shift; $self->{skip}++ } +sub skip { + my $self = shift; + return $self->{skip} || 0; +} + +sub inc_todo { my $self = shift; $self->{todo}++ } +sub todo { + my $self = shift; + return $self->{todo} || 0; +} + +sub inc_seen { my $self = shift; $self->{seen}++ } +sub seen { + my $self = shift; + return $self->{seen} || 0; +} + +sub set_details { + my $self = shift; + my $index = shift; + my $details = shift; + + my $array = ($self->{details} ||= []); + $array->[$index-1] = $details; +} + +sub details { + my $self = shift; + return $self->{details} || []; +} + +1; diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 5804296..5a88e14 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -9,6 +9,7 @@ use Config; use Test::Harness::Assert; use Test::Harness::Iterator; use Test::Harness::Point; +use Test::Harness::Results; # Flags used as return values from our methods. Just for internal # clarification. @@ -26,9 +27,9 @@ Test::Harness::Straps - detailed analysis of test results my $strap = Test::Harness::Straps->new; # Various ways to interpret a test - my %results = $strap->analyze($name, \@test_output); - my %results = $strap->analyze_fh($name, $test_filehandle); - my %results = $strap->analyze_file($test_file); + my $results = $strap->analyze($name, \@test_output); + my $results = $strap->analyze_fh($name, $test_filehandle); + my $results = $strap->analyze_file($test_file); # UNIMPLEMENTED my %total = $strap->total_results; @@ -93,10 +94,10 @@ sub _init { =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. +for use in the total report. Returns the C<$results> of the test. See L. C<@test_output> should be the raw output from the test, including @@ -117,41 +118,35 @@ sub _analyze_iterator { $self->_reset_file_state; $self->{file} = $name; - my %totals = ( - max => 0, - seen => 0, - ok => 0, - todo => 0, - skip => 0, - bonus => 0, - - details => [] - ); + my $results = Test::Harness::Results->new; # Set them up here so callbacks can have them. - $self->{totals}{$name} = \%totals; + $self->{totals}{$name} = $results; while( defined(my $line = $it->next) ) { - $self->_analyze_line($line, \%totals); + $self->_analyze_line($line, $results); last if $self->{saw_bailout}; } - $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; + $results->set_skip_all( $self->{skip_all} ) if defined $self->{skip_all}; + + my $passed = + (($results->max == 0) && defined $results->skip_all) || + ($results->max && + $results->seen && + $results->max == $results->seen && + $results->max == $results->ok); - my $passed = ($totals{max} == 0 && defined $totals{skip_all}) || - ($totals{max} && $totals{seen} && - $totals{max} == $totals{seen} && - $totals{max} == $totals{ok}); - $totals{passing} = $passed ? 1 : 0; + $results->set_passing( $passed ? 1 : 0 ); - return %totals; + return $results; } sub _analyze_line { my $self = shift; my $line = shift; - my $totals = shift; + my $results = shift; $self->{line}++; @@ -160,7 +155,7 @@ sub _analyze_line { if ( $point ) { $linetype = 'test'; - $totals->{seen}++; + $results->inc_seen; $point->set_number( $self->{'next'} ) unless $point->number; # sometimes the 'not ' and the 'ok' are on different lines, @@ -176,14 +171,14 @@ sub _analyze_line { } if ( $point->is_todo ) { - $totals->{todo}++; - $totals->{bonus}++ if $point->ok; + $results->inc_todo; + $results->inc_bonus if $point->ok; } elsif ( $point->is_skip ) { - $totals->{skip}++; + $results->inc_skip; } - $totals->{ok}++ if $point->pass; + $results->inc_ok if $point->pass; if ( ($point->number > 100_000) && ($point->number > ($self->{max}||100_000)) ) { if ( !$self->{too_many_tests}++ ) { @@ -201,7 +196,7 @@ sub _analyze_line { }; assert( defined( $details->{ok} ) && defined( $details->{actual_ok} ) ); - $totals->{details}[$point->number - 1] = $details; + $results->set_details( $point->number, $details ); } } # test point elsif ( $line =~ /^not\s+$/ ) { @@ -215,7 +210,7 @@ sub _analyze_line { $self->{saw_header}++; - $totals->{max} += $self->{max}; + $results->inc_max( $self->{max} ); } elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) { $linetype = 'bailout'; @@ -223,7 +218,8 @@ sub _analyze_line { } elsif (my $diagnostics = $self->_is_diagnostic_line( $line )) { $linetype = 'other'; - my $test = $totals->{details}[-1]; + # XXX We can throw this away, really. + my $test = $results->details->[-1]; $test->{diagnostics} ||= ''; $test->{diagnostics} .= $diagnostics; } @@ -231,7 +227,7 @@ sub _analyze_line { $linetype = 'other'; } - $self->{callback}->($self, $line, $linetype, $totals) if $self->{callback}; + $self->callback->($self, $line, $linetype, $results) if $self->callback; $self->{'next'} = $point->number + 1 if $point; } # _analyze_line @@ -246,7 +242,7 @@ sub _is_diagnostic_line { =for private $strap->analyze_fh( $name, $test_filehandle ) - my %results = $strap->analyze_fh($name, $test_filehandle); + my $results = $strap->analyze_fh($name, $test_filehandle); Like C, but it reads from the given filehandle. @@ -261,7 +257,7 @@ sub analyze_fh { =head2 $strap->analyze_file( $test_file ) - my %results = $strap->analyze_file($test_file); + my $results = $strap->analyze_file($test_file); Like C, but it runs the given C<$test_file> and parses its results. It will also use that name for the total report. @@ -295,20 +291,21 @@ sub analyze_file { return; } - my %results = $self->analyze_fh($file, \*FILE); + my $results = $self->analyze_fh($file, \*FILE); my $exit = close FILE; - $results{'wait'} = $?; - if( $? && $self->{_is_vms} ) { - eval q{use vmsish "status"; $results{'exit'} = $?}; + + $results->set_wait($?); + if ( $? && $self->{_is_vms} ) { + eval q{use vmsish "status"; $results->set_exit($?); }; } else { - $results{'exit'} = _wait2exit($?); + $results->set_exit( _wait2exit($?) ); } - $results{passing} = 0 unless $? == 0; + $results->set_passing(0) unless $? == 0; $self->_restore_PERL5LIB(); - return %results; + return $results; } @@ -617,51 +614,6 @@ sub _reset_file_state { $self->{'next'} = 1; } -=head1 Results - -The C<%results> returned from C contain the following -information: - - passing true if the whole test is considered a pass - (or skipped), false if its a failure - - exit the exit code of the test run, if from a file - wait the wait code of the test run, if from a file - - max total tests which should have been run - seen total tests actually seen - skip_all if the whole test was skipped, this will - contain the reason. - - ok number of tests which passed - (including todo and skips) - - todo number of todo tests seen - bonus number of todo tests which - unexpectedly passed - - skip number of tests skipped - -So a successful test should have max == seen == ok. - - -There is one final item, the details. - - details an array ref reporting the result of - each test looks like this: - - $results{details}[$test_num - 1] = - { ok => is the test considered ok? - actual_ok => did it literally say 'ok'? - name => name of the test (if any) - diagnostics => test diagnostics (if any) - type => 'skip' or 'todo' (if any) - reason => reason for the above (if any) - }; - -Element 0 of the details is test #1. I tried it with element 1 being -#1 and 0 being empty, this is less awkward. - =head1 EXAMPLES See F for an example of use. @@ -682,4 +634,14 @@ sub _def_or_blank { return ""; } +sub set_callback { + my $self = shift; + $self->{callback} = shift; +} + +sub callback { + my $self = shift; + return $self->{callback}; +} + 1; diff --git a/lib/Test/Harness/Util.pm b/lib/Test/Harness/Util.pm index 9218d30..0cda2fe 100644 --- a/lib/Test/Harness/Util.pm +++ b/lib/Test/Harness/Util.pm @@ -4,6 +4,7 @@ use strict; use vars qw($VERSION); $VERSION = '0.01'; +use File::Spec; use Exporter; use vars qw( @ISA @EXPORT @EXPORT_OK ); diff --git a/lib/Test/Harness/bin/prove b/lib/Test/Harness/bin/prove index a3a3065..fb5bf0f 100644 --- a/lib/Test/Harness/bin/prove +++ b/lib/Test/Harness/bin/prove @@ -10,7 +10,7 @@ use Pod::Usage 1.12; use File::Spec; use vars qw( $VERSION ); -$VERSION = "1.04"; +$VERSION = '2.64'; my $shuffle = 0; my $dry = 0; @@ -25,10 +25,10 @@ my @switches = (); # Stick any default switches at the beginning, so they can be overridden # by the command line switches. -unshift @ARGV, split( " ", $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES}; +unshift @ARGV, split( ' ', $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES}; -Getopt::Long::Configure( "no_ignore_case" ); -Getopt::Long::Configure( "bundling" ); +Getopt::Long::Configure( 'no_ignore_case' ); +Getopt::Long::Configure( 'bundling' ); GetOptions( 'b|blib' => \$blib, 'd|debug' => \$Test::Harness::debug, @@ -37,13 +37,14 @@ GetOptions( 'H|man' => sub {pod2usage({-verbose => 2}); exit}, 'I=s@' => \@includes, 'l|lib' => \$lib, - 'perl' => \$ENV{HARNESS_PERL}, + 'perl=s' => \$ENV{HARNESS_PERL}, 'r|recurse' => \$recurse, 's|shuffle' => \$shuffle, - 't' => sub { unshift @switches, "-t" }, # Always want -t up front - 'T' => sub { unshift @switches, "-T" }, # Always want -T up front + 't' => sub { unshift @switches, '-t' }, # Always want -t up front + 'T' => sub { unshift @switches, '-T' }, # Always want -T up front 'w' => sub { push @switches, '-w' }, 'W' => sub { push @switches, '-W' }, + 'strap=s' => \$ENV{HARNESS_STRAP_CLASS}, 'timer' => \$Test::Harness::Timer, 'v|verbose' => \$Test::Harness::verbose, 'V|version' => sub { print_version(); exit; }, @@ -64,12 +65,12 @@ if ( $blib ) { # Handle lib includes if ( $lib ) { - unshift @includes, "lib"; + unshift @includes, 'lib'; } # Build up TH switches push( @switches, map { /\s/ && !/^".*"$/ ? qq["-I$_"] : "-I$_" } @includes ); -$Test::Harness::Switches = join( " ", @switches ); +$Test::Harness::Switches = join( ' ', @switches ); print "# \$Test::Harness::Switches: $Test::Harness::Switches\n" if $Test::Harness::debug; @ARGV = File::Spec->curdir unless @ARGV; @@ -90,7 +91,7 @@ for ( @argv_globbed ) { if ( @tests ) { shuffle(@tests) if $shuffle; if ( $dry ) { - print join( "\n", @tests, "" ); + print join( "\n", @tests, '' ); } else { print "# ", scalar @tests, " tests to run\n" if $Test::Harness::debug; @@ -125,6 +126,7 @@ prove [options] [files/directories] --perl Sets the name of the Perl executable to use -r, --recurse Recursively descend into directories -s, --shuffle Run the tests in a random order + --strap Define strap class to use -T Enable tainting checks -t Enable tainting warnings --timer Print elapsed time after each test file @@ -232,6 +234,11 @@ order are likely to be revealed. The author hopes the run the algorithm on the preceding sentence to see if he can produce something slightly less awkward. +=head2 --strap + +Sets the HARNESS_STRAP_CLASS variable to set which Test::Harness::Straps +variable to use in running the tests. + =head2 -t Runs test programs under perl's -t taint warning mode. @@ -275,7 +282,7 @@ Andy Lester C<< >> =head1 COPYRIGHT -Copyright 2005 by Andy Lester C<< >>. +Copyright 2004-2006 by Andy Lester C<< >>. 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/t/00compile.t b/lib/Test/Harness/t/00compile.t index ad4ddde..0b8ad82 100644 --- a/lib/Test/Harness/t/00compile.t +++ b/lib/Test/Harness/t/00compile.t @@ -10,7 +10,7 @@ BEGIN { } } -use Test::More tests => 6; +use Test::More tests => 8; BEGIN { use_ok 'Test::Harness' } BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION under Perl $] and Test::More $Test::More::VERSION" ) unless $ENV{PERL_CORE}} @@ -23,6 +23,10 @@ BEGIN { use_ok 'Test::Harness::Assert' } BEGIN { use_ok 'Test::Harness::Point' } +BEGIN { use_ok 'Test::Harness::Results' } + +BEGIN { use_ok 'Test::Harness::Util' } + # If the $VERSION is set improperly, this will spew big warnings. BEGIN { use_ok 'Test::Harness', 1.1601 } diff --git a/lib/Test/Harness/t/callback.t b/lib/Test/Harness/t/callback.t index 4164da4..9681aa7 100644 --- a/lib/Test/Harness/t/callback.t +++ b/lib/Test/Harness/t/callback.t @@ -52,10 +52,12 @@ my $SAMPLE_TESTS = $ENV{PERL_CORE} my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps' ); -$strap->{callback} = sub { - my($self, $line, $type, $totals) = @_; - push @out, $type; -}; +$strap->set_callback( + sub { + my($self, $line, $type, $totals) = @_; + push @out, $type; + } +); for my $test ( sort keys %samples ) { my $expect = $samples{$test}; diff --git a/lib/Test/Harness/t/prove-switches.t b/lib/Test/Harness/t/prove-switches.t index cf753ac..79c0641 100644 --- a/lib/Test/Harness/t/prove-switches.t +++ b/lib/Test/Harness/t/prove-switches.t @@ -18,7 +18,7 @@ plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE"; # 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; +plan tests => 8; my $blib = File::Spec->catfile( File::Spec->curdir, "blib" ); my $blib_lib = File::Spec->catfile( $blib, "lib" ); @@ -28,7 +28,6 @@ $prove = "$^X $prove"; CAPITAL_TAINT: { local $ENV{PROVE_SWITCHES}; - local $/ = undef; my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/; my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" ); @@ -37,7 +36,6 @@ CAPITAL_TAINT: { LOWERCASE_TAINT: { local $ENV{PROVE_SWITCHES}; - local $/ = undef; my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/; my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" ); @@ -46,7 +44,6 @@ LOWERCASE_TAINT: { PROVE_SWITCHES: { local $ENV{PROVE_SWITCHES} = "-dvb -I fark"; - local $/ = undef; my @actual = qx/$prove -Ibork -Dd/; my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" ); @@ -54,17 +51,25 @@ PROVE_SWITCHES: { } PROVE_SWITCHES_L: { - local $/ = undef; - my @actual = qx/$prove -l -Ibongo -Dd/; my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" ); is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" ); } PROVE_SWITCHES_LB: { - local $/ = undef; - my @actual = qx/$prove -lb -Dd/; my @expected = ( "# \$Test::Harness::Switches: -Ilib -I$blib_arch -I$blib_lib\n" ); is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" ); } + +PROVE_VERSION: { + # This also checks that the prove $VERSION is in sync with Test::Harness's $VERSION + local $/ = undef; + + use_ok( 'Test::Harness' ); + + my $thv = $Test::Harness::VERSION; + my @actual = qx/$prove --version/; + is( scalar @actual, 1, 'Only 1 line returned' ); + like( $actual[0], qq{/^\Qprove v$thv, using Test::Harness v$thv and Perl v5\E/} ); +} diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index 5732b15..4e38ee3 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -11,7 +11,7 @@ BEGIN { } use strict; -use Test::More; +use Test::More tests => 247; use File::Spec; my $Curdir = File::Spec->curdir; @@ -544,7 +544,6 @@ my %samples = ( 'wait' => 0 }, ); -plan tests => (keys(%samples) * 5) + 3; use Test::Harness::Straps; my @_INC = map { qq{"-I$_"} } @INC; @@ -568,34 +567,33 @@ for my $test ( sort keys %samples ) { my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps' ); - my %results = $strap->analyze_file($test_path); + my $results = $strap->analyze_file($test_path); - is_deeply($results{details}, $expect->{details}, qq{details of "$test"} ); + is_deeply($results->details, $expect->{details}, qq{details of "$test"} ); delete $expect->{details}; - delete $results{details}; SKIP: { skip '$? unreliable in MacPerl', 2 if $IsMacPerl; # We can only check if it's zero or non-zero. - is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' ); - delete $results{'wait'}; + is( !$results->wait, !$expect->{'wait'}, 'wait status' ); delete $expect->{'wait'}; # Have to check the exit status seperately so we can skip it # in MacPerl. - is( $results{'exit'}, $expect->{'exit'} ); - delete $results{'exit'}; + is( $results->exit, $expect->{'exit'}, 'exit matches' ); delete $expect->{'exit'}; } - is_deeply(\%results, $expect, qq{ the rest of "$test"} ); + for my $field ( sort keys %$expect ) { + is( $results->$field(), $expect->{$field}, "Field $field" ); + } } # for %samples NON_EXISTENT_FILE: { my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps' ); - ok( !$strap->analyze_file('I_dont_exist') ); - is( $strap->{error}, "I_dont_exist does not exist" ); + ok( !$strap->analyze_file('I_dont_exist'), "Can't analyze a non-existant file" ); + is( $strap->{error}, "I_dont_exist does not exist", "And there should be one error" ); } diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t index dbdc6f9..88d28a9 100644 --- a/lib/Test/Harness/t/test-harness.t +++ b/lib/Test/Harness/t/test-harness.t @@ -504,11 +504,12 @@ SKIP: { my $expect = $samples{$test}; # execute_tests() runs the tests but skips the formatting. - my($totals, $failed); - my $warning = ''; my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); print STDERR "# $test\n" if $ENV{TEST_VERBOSE}; + my $totals; + my $failed; + my $warning = ''; eval { local $SIG{__WARN__} = sub { $warning .= join '', @_; }; ($totals, $failed) = Test::Harness::execute_tests(tests => [$test_path], out => \*NULL); @@ -524,7 +525,7 @@ SKIP: { SKIP: { skip "don't apply to a bailout", 6 if $test eq 'bailout'; - is( $@, '' ); + is( $@, '', '$@ is empty' ); is( Test::Harness::_all_ok($totals), $expect->{all_ok}, "$test - all ok" ); ok( defined $expect->{total}, "$test - has total" ); @@ -539,7 +540,7 @@ SKIP: { skip "No tests were run", 1 unless $totals->{max}; my $output = Test::Harness::get_results($totals, $failed); - like( $output, '/All tests successful|List of Failed/' ); + like( $output, '/All tests successful|List of Failed/', 'Got what looks like a valid summary' ); } my $expected_warnings = "";