ext/Test-Harness/t/compat/inc_taint.t Test::Harness test
ext/Test-Harness/t/compat/nonumbers.t Test::Harness test
ext/Test-Harness/t/compat/regression.t Test::Harness test
+ext/Test-Harness/t/compat/switches.t Test::Harness test
ext/Test-Harness/t/compat/test-harness-compat.t Test::Harness test
ext/Test-Harness/t/compat/version.t Test::Harness test
ext/Test-Harness/t/console.t Test::Harness test
ext/Test-Harness/t/premature-bailout.t Test::Harness test
ext/Test-Harness/t/process.t Test::Harness test
ext/Test-Harness/t/proveenv.t Test::Harness test
+ext/Test-Harness/t/proverc/emptyexec Test data for Test::Harness
ext/Test-Harness/t/proverc.t Test::Harness test
ext/Test-Harness/t/proverun.t Test::Harness test
ext/Test-Harness/t/prove.t Test::Harness test
ext/Test-Harness/t/sample-tests/version_old Test data for Test::Harness
ext/Test-Harness/t/sample-tests/vms_nit Test data for Test::Harness
ext/Test-Harness/t/sample-tests/with_comments Test data for Test::Harness
+ext/Test-Harness/t/sample-tests/zero_valid Test data for Test::Harness
ext/Test-Harness/t/scheduler.t Test::Harness test
ext/Test-Harness/t/source.t Test::Harness test
ext/Test-Harness/t/source_tests/harness Test data for Test::Harness
Revision history for Test-Harness
+3.17 2009-05-05
+ - Changed the 'failures' so that it is overridden by verbosity rather
+ than the other way around.
+ - Added the 'comments' option, most useful when used in conjunction
+ with the 'failures' option.
+ - Deprecated support for Perls earlier than 5.6.0.
+ - Allow '-I lib' as well as '-Ilib' in $Test::Harness::Switches
+ (regression).
+ - Restore old skip parsing semantics for TAP < v13. Refs #39031.
+ - Numerous small documentation fixes.
+ - Remove support for fork-based parallel testing. Multiplexed
+ parallel testing remains.
+
3.16 2009-02-19
- Fix path splicing on platforms where the path separator
is not ':'.
--nocount Disable the X/Y test count.
-D --dry Dry run. Show test that would have run.
--ext Set the extension for tests (default '.t')
- -f, --failures Only show failed tests.
+ -f, --failures Show failed tests.
+ -o, --comments Show comments.
--fork Fork to run harness in multiple processes.
--ignore-exit Ignore exit status from test scripts.
-m, --merge Merge test scripts' STDERR with their STDOUT.
-p, --parse Show full list of TAP parse errors, if any.
--directives Only show results with TODO or SKIP directives.
--timer Print elapsed time after each test.
+ --normalize Normalize TAP output in verbose output
-T Enable tainting checks.
-t Enable tainting warnings.
-W Enable fatal warnings.
L<Win32::Console> windows. If the necessary module is not installed
colored output will not be available.
+=head2 Exit Code
+
+If the tests fail C<prove> will exit with non-zero status.
+
=head2 Arguments to Tests
It is possible to supply arguments to tests. To do so separate them from
$ prove -b --state=hot --state=all,save
+=head2 @INC
+
+prove introduces a separation between "options passed to the perl which
+runs prove" and "options passed to the perl which runs tests"; this
+distinction is by design. Thus the perl which is running a test starts
+with the default C<@INC>. Additional library directories can be added
+via the C<PERL5LIB> environment variable, via -Ifoo in C<PERL5OPT> or
+via the C<-Ilib> option to F<prove>.
+
=head2 Taint Mode
Normally when a Perl program is run in taint mode the contents of the
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
@ISA = qw(TAP::Object);
@ATTR = qw(
- archive argv blib show_count color directives exec failures fork
+ archive argv blib show_count color directives exec failures comments
formatter harness includes modules plugins jobs lib merge parse quiet
really_quiet recurse backwards shuffle taint_fail taint_warn timer
verbose warnings_fail warnings_warn show_help show_man show_version
state_class test_args state dry extension ignore_exit rules state_manager
+ normalize
);
__PACKAGE__->mk_methods(@ATTR);
}
local *RC;
open RC, "<$rc_file" or croak "Can't read $rc_file ($!)";
while ( defined( my $line = <RC> ) ) {
- push @{ $self->{rc_opts} }, grep $_ && $_ !~ /^#/,
- $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S*) }xg;
+ push @{ $self->{rc_opts} },
+ grep { defined and not /^#/ }
+ $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S+) }xg;
}
close RC;
}
GetOptions(
'v|verbose' => \$self->{verbose},
'f|failures' => \$self->{failures},
+ 'o|comments' => \$self->{comments},
'l|lib' => \$self->{lib},
'b|blib' => \$self->{blib},
's|shuffle' => \$self->{shuffle},
'formatter=s' => \$self->{formatter},
'r|recurse' => \$self->{recurse},
'reverse' => \$self->{backwards},
- 'fork' => \$self->{fork},
'p|parse' => \$self->{parse},
'q|quiet' => \$self->{quiet},
'Q|QUIET' => \$self->{really_quiet},
't' => \$self->{taint_warn},
'W' => \$self->{warnings_fail},
'w' => \$self->{warnings_warn},
+ 'normalize' => \$self->{normalize},
'rules=s@' => $self->{rules},
) or croak('Unable to continue');
sub _color_default {
my $self = shift;
- return -t STDOUT && !IS_WIN32;
+ return -t STDOUT && !$ENV{HARNESS_NOTTY} && !IS_WIN32;
}
sub _get_args {
$args{jobs} = $jobs;
}
- if ( my $fork = $self->fork ) {
- $args{fork} = $fork;
- }
-
if ( my $harness_opt = $self->harness ) {
$self->require_harness( harness => $harness_opt );
}
$args{verbosity} = shift @verb_adj || 0;
- for my $a (qw( merge failures timer directives )) {
+ for my $a (qw( merge failures comments timer directives normalize )) {
$args{$a} = 1 if $self->$a();
}
=item C<failures>
-=item C<fork>
+=item C<comments>
=item C<formatter>
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head3 C<apply_switch>
-Apply a list of switch options to the state.
+ $self->apply_switch('failed,save');
+
+Apply a list of switch options to the state, updating the internal
+object state as a result. Nothing is returned.
+
+Diagnostics:
+ - "Illegal state option: %s"
=over
|| croak "Illegal state option: $opt";
$code->($arg);
}
+ return;
}
sub _select {
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
-my $GOT_TIME_HIRES;
-
-BEGIN {
+use constant GOT_TIME_HIRES => do {
eval 'use Time::HiRes qw(time);';
- $GOT_TIME_HIRES = $@ ? 0 : 1;
-}
+ $@ ? 0 : 1;
+};
=head1 SYNOPSIS
=cut
-sub time_is_hires { return $GOT_TIME_HIRES }
+sub time_is_hires { return GOT_TIME_HIRES }
1;
%VALIDATION_FOR = (
directives => sub { shift; shift },
verbosity => sub { shift; shift },
+ normalize => sub { shift; shift },
timer => sub { shift; shift },
failures => sub { shift; shift },
+ comments => sub { shift; shift },
errors => sub { shift; shift },
color => sub { shift; shift },
jobs => sub { shift; shift },
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=item * C<failures>
-Only show test failures (this is a no-op if C<verbose> is selected).
+Show test failures (this is a no-op if C<verbose> is selected).
+
+=item * C<comments>
+
+Show test comments (this is a no-op if C<verbose> is selected).
=item * C<quiet>
=item * C<directives>
If set to a true value, only test results with directives will be displayed.
-This overrides other settings such as C<verbose> or C<failures>.
+This overrides other settings such as C<verbose>, C<failures>, or C<comments>.
=item * C<stdout>
die "Unimplemented.";
}
+sub _output_success {
+ my ( $self, $msg ) = @_;
+ $self->_output($msg);
+}
+
=head3 C<summary>
$harness->summary( $aggregate );
# the exit status is nonzero
if ( $aggregate->all_passed ) {
- $self->_output("All tests successful.\n");
+ $self->_output_success("All tests successful.\n");
}
# ~TODO option where $aggregate->skipped generates reports
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
}
}
+sub _output_success {
+ my ( $self, $msg ) = @_;
+ $self->_set_colors('green');
+ $self->_output($msg);
+ $self->_set_colors('reset');
+}
+
sub _failure_output {
my $self = shift;
$self->_set_colors('red');
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
last;
}
}
- $formatter->_output( $result->as_string );
+ $formatter->_output( $self->_format_for_output($result) );
$formatter->_set_colors('reset');
}
: sub {
- $formatter->_output( shift->as_string );
+ $formatter->_output( $self->_format_for_output(shift) );
};
}
my $verbose = $formatter->verbose;
my $directives = $formatter->directives;
my $failures = $formatter->failures;
+ my $comments = $formatter->comments;
my $output_result = $self->_get_output_result;
}
if (!$quiet
- && ( ( $verbose && !$failures )
+ && ( $verbose
|| ( $is_test && $failures && !$result->is_ok )
- || ( $result->has_directive && $directives ) )
+ || ( $comments && $result->is_comment )
+ || ( $directives && $result->has_directive ) )
)
{
unless ($newline_printed) {
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
}
if (!$formatter->quiet
- && ( ( $formatter->verbose && !$formatter->failures )
+ && ( $formatter->verbose
|| ( $result->is_test && $formatter->failures && !$result->is_ok )
+ || ( $formatter->comments && $result->is_comment )
|| ( $result->has_directive && $formatter->directives ) )
)
{
- $self->{results} .= $result->as_string . "\n";
+ $self->{results} .= $self->_format_for_output($result) . "\n";
}
}
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 METHODS
sub _should_show_count {
my $self = shift;
- return !$self->formatter->verbose && -t $self->formatter->stdout;
+ return
+ !$self->formatter->verbose
+ && -t $self->formatter->stdout
+ && !$ENV{HARNESS_NOTTY};
+}
+
+sub _format_for_output {
+ my ( $self, $result ) = @_;
+ return $self->formatter->normalize ? $result->as_string : $result->raw;
}
sub _output_test_failure {
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_VERSION} = $VERSION;
BEGIN {
@FORMATTER_ARGS = qw(
- directives verbosity timer failures errors stdout color show_count
+ directives verbosity timer failures comments errors stdout color
+ show_count normalize
);
%VALIDATION_FOR = (
scheduler_class => sub { shift; shift },
formatter => sub { shift; shift },
jobs => sub { shift; shift },
- fork => sub { shift; shift },
test_args => sub { shift; shift },
ignore_exit => sub { shift; shift },
rules => sub { shift; shift },
my %args = (
verbosity => 1,
- lib => [ 'lib', 'blib/lib' ],
+ lib => [ 'lib', 'blib/lib', 'blib/arch' ],
)
my $harness = TAP::Harness->new( \%args );
=item * C<failures>
-Only show test failures (this is a no-op if C<verbose> is selected).
+Show test failures (this is a no-op if C<verbose> is selected).
+
+=item * C<comments>
+
+Show test comments (this is a no-op if C<verbose> is selected).
=item * C<show_count>
Update the running test count during testing.
+=item * C<normalize>
+
+Set to a true value to normalize the TAP that is emitted in verbose modes.
+
=item * C<lib>
Accepts a scalar value or array ref of scalar values indicating which
if $test_file =~ /[.]rb$/;
}
+If the subroutine returns a scalar with a newline or a filehandle, it
+will be interpreted as raw TAP or as a TAP stream, respectively.
+
=item * C<merge>
If C<merge> is true the harness will create parsers that merge STDOUT
can be run in parallel is controlled by C<rules>. The default is to
run only one test at a time.
-=item * C<fork>
-
-If true the harness will attempt to fork and run the parser for each
-test in a separate process. Currently this option requires
-L<Parallel::Iterator> to be installed.
-
=item * C<rules>
A reference to a hash of rules that control which tests may be
$self->jobs(1) unless defined $self->jobs;
local $default_class{formatter_class} = 'TAP::Formatter::File'
- unless -t ( $arg_for{stdout} || \*STDOUT );
+ unless -t ( $arg_for{stdout} || \*STDOUT ) && !$ENV{HARNESS_NOTTY};
while ( my ( $attr, $class ) = each %default_class ) {
$self->$attr( $self->$attr() || $class );
$aggregate->add( $job->description, $parser );
}
-sub _aggregate_forked {
- my ( $self, $aggregate, $scheduler ) = @_;
-
- eval { require Parallel::Iterator };
-
- croak "Parallel::Iterator required for --fork option ($@)"
- if $@;
-
- my $iter = Parallel::Iterator::iterate(
- { workers => $self->jobs || 0 },
- sub {
- my $job = shift;
-
- return if $job->is_spinner;
-
- my ( $parser, $session ) = $self->make_parser($job);
-
- while ( defined( my $result = $parser->next ) ) {
- $self->_bailout($result) if $result->is_bailout;
- }
-
- $self->finish_parser( $parser, $session );
-
- # Can't serialise coderefs...
- delete $parser->{_iter};
- delete $parser->{_stream};
- delete $parser->{_grammar};
- return $parser;
- },
- sub { $scheduler->get_job }
- );
-
- while ( my ( $job, $parser ) = $iter->() ) {
- next if $job->is_spinner;
- $self->_after_test( $aggregate, $job, $parser );
- $job->finish;
- }
-
- return;
-}
-
sub _bailout {
my ( $self, $result ) = @_;
my $explanation = $result->explanation;
$self->formatter->prepare( map { $_->description } $scheduler->get_all );
if ( $self->jobs > 1 ) {
- if ( $self->fork ) {
- $self->_aggregate_forked( $aggregate, $scheduler );
- }
- else {
- $self->_aggregate_parallel( $aggregate, $scheduler );
- }
+ $self->_aggregate_parallel( $aggregate, $scheduler );
}
else {
$self->_aggregate_single( $aggregate, $scheduler );
handling. By default, this value is 1 -- for parallel testing, this
should be set higher.
-=head3 C<fork>
-
-If true the harness will attempt to fork and run the parser for each
-test in a separate process. Currently this option requires
-L<Parallel::Iterator> to be installed.
-
=cut
##############################################################################
= ref $exec eq 'CODE'
? $exec->( $self, $test_prog )
: [ @$exec, $test_prog ];
- $args{source} = $test_prog unless $args{exec};
+ if ( not defined $args{exec} ) {
+ $args{source} = $test_prog;
+ }
+ elsif ( ( ref( $args{exec} ) || "" ) ne "ARRAY" ) {
+ $args{source} = delete $args{exec};
+ }
}
else {
$args{source} = $test_prog;
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
my $DEFAULT_TAP_VERSION = 12;
my $MAX_TAP_VERSION = 13;
$stream = $source->get_stream($self);
}
elsif ($source) {
- if ( ref $source ) {
+ if ( $source =~ /\n/ ) {
+ $stream
+ = $self->_iterator_for_source( [ split "\n" => $source ] );
+ }
+ elsif ( ref $source ) {
$stream = $self->_iterator_for_source($source);
}
elsif ( -e $source ) {
}
}
- if ($number) {
+ if ( defined $number ) {
if ( $number != $tests_run ) {
my $count = $tests_run;
$self->_add_error( "Tests out of sequence. Found "
}
else {
$result = $end_handler->();
- $self->_make_callback( 'EOF', $result )
+ $self->_make_callback( 'EOF', $self )
unless defined $result;
}
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
$skip = 'SKIP';
# If we can't match # SKIP the directive should be undef.
- ($explanation) = $tail =~ /^#\s*SKIP\s+(.*)/i;
+ ($explanation) = $tail =~ /^#\s*SKIP\S*\s+(.*)/i;
}
elsif ( $tail !~ /^\s*$/ ) {
return $self->_make_unknown_token($line);
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head2 DESCRIPTION
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
=head1 SYNOPSIS
use TAP::Object ();
@ISA = 'TAP::Object';
-$VERSION = '3.16';
+$VERSION = '3.17';
# TODO:
# Handle blessed object syntax
=head1 VERSION
-Version 3.16
+Version 3.17
=head1 SYNOPSIS
use TAP::Object ();
@ISA = 'TAP::Object';
-$VERSION = '3.16';
+$VERSION = '3.17';
my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
=head1 VERSION
-Version 3.16
+Version 3.17
=head1 SYNOPSIS
=head1 VERSION
-Version 3.16
+Version 3.17
=cut
-$VERSION = '3.16';
+$VERSION = '3.17';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
my $sub_args = shift || {};
my ( @lib, @switches );
- for my $opt ( split_shell( $Switches, $ENV{HARNESS_PERL_SWITCHES} ) ) {
+ my @opt = split_shell( $Switches, $ENV{HARNESS_PERL_SWITCHES} );
+ while ( my $opt = shift @opt ) {
if ( $opt =~ /^ -I (.*) $ /x ) {
- push @lib, $1;
+ push @lib, length($1) ? $1 : shift @opt;
}
else {
push @switches, $opt;
if ( $opt =~ /^j(\d*)$/ ) {
$args->{jobs} = $1 || 9;
}
- elsif ( $opt eq 'f' ) {
- $args->{fork} = 1;
- }
elsif ( $opt eq 'c' ) {
$args->{color} = 1;
}
$plan_output = $plan->as_string;
},
EOF => sub {
- $end = 1 if $all == 8;
+ my $p = shift;
+ $end = 1 if $all == 8 and $p->isa('TAP::Parser');
},
ELSE => sub {
$else++;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More (
+ $^O eq 'VMS'
+ ? ( skip_all => 'VMS' )
+ : ( tests => 4 )
+);
+
+use Test::Harness;
+
+for my $switch ( '-Ifoo', '-I foo' ) {
+ $Test::Harness::Switches = $switch;
+ ok my $harness = Test::Harness::_new_harness, 'made harness';
+ is_deeply [ $harness->lib ], ['-Ifoo'], 'got libs';
+}
+
my $sample_tests
= $ENV{PERL_CORE} ? '../ext/Test-Harness/t/sample-tests' : 't/sample-tests';
-plan tests => 41;
+plan tests => 56;
# note that this test will always pass when run through 'prove'
ok $ENV{HARNESS_ACTIVE}, 'HARNESS_ACTIVE env variable should be set';
trim($_)
} map { split /\n/ } @_;
};
- my $harness = TAP::Harness->new( { verbosity => 1 } );
+
+ # Make sure verbosity 1 overrides failures and comments.
+ my $harness = TAP::Harness->new(
+ { verbosity => 1,
+ failures => 1,
+ comments => 1,
+ }
+ );
my $harness_whisper = TAP::Harness->new( { verbosity => -1 } );
my $harness_mute = TAP::Harness->new( { verbosity => -2 } );
my $harness_directives = TAP::Harness->new( { directives => 1 } );
my $harness_failures = TAP::Harness->new( { failures => 1 } );
+ my $harness_comments = TAP::Harness->new( { comments => 1 } );
+ my $harness_fandc = TAP::Harness->new(
+ { failures => 1,
+ comments => 1
+ }
+ );
can_ok $harness, 'runtests';
my $summary = pop @output;
my $expected_summary = qr{^Files=1, Tests=1, \d+ wallclock secs};
- is_deeply \@output, \@expected, '... and the output should be correct';
+ is_deeply \@output, \@expected, '... the output should be correct';
like $status, $expected_status,
'... and the status line should be correct';
like $summary, $expected_summary,
@output = ();
ok $aggregate
= _runtests( $harness, [ "$source_tests/harness", 'My Nice Test' ] ),
- '... runtests returns the aggregate';
+ 'runtests returns the aggregate';
isa_ok $aggregate, 'TAP::Parser::Aggregator';
$summary = pop @output;
$expected_summary = qr{^Files=1, Tests=1, \d+ wallclock secs};
- is_deeply \@output, \@expected, '... and the output should be correct';
+ is_deeply \@output, \@expected, '... the output should be correct';
like $status, $expected_status,
'... and the status line should be correct';
like $summary, $expected_summary,
$harness, [ "$source_tests/harness", 'My Nice Test' ],
[ "$source_tests/harness", 'My Nice Test Again' ]
),
- '... runtests returns the aggregate';
+ 'runtests labels returns the aggregate';
isa_ok $aggregate, 'TAP::Parser::Aggregator';
$summary = pop @output;
$expected_summary = qr{^Files=2, Tests=2, \d+ wallclock secs};
- is_deeply \@output, \@expected, '... and the output should be correct';
+ is_deeply \@output, \@expected, '... the output should be correct';
like $status, $expected_status,
'... and the status line should be correct';
like $summary, $expected_summary,
# normal tests in quiet mode
@output = ();
- _runtests( $harness_whisper, "$source_tests/harness" );
+ ok _runtests( $harness_whisper, "$source_tests/harness" ),
+ 'Run tests with whisper';
chomp(@output);
@expected = (
$summary = pop @output;
$expected_summary = qr/^Files=1, Tests=1, \d+ wallclock secs/;
- is_deeply \@output, \@expected, '... and the output should be correct';
+ is_deeply \@output, \@expected, '... the output should be correct';
like $status, $expected_status,
'... and the status line should be correct';
like $summary, $expected_summary,
# normal tests in really_quiet mode
@output = ();
- _runtests( $harness_mute, "$source_tests/harness" );
+ ok _runtests( $harness_mute, "$source_tests/harness" ), 'Run tests mute';
chomp(@output);
@expected = (
$summary = pop @output;
$expected_summary = qr/^Files=1, Tests=1, \d+ wallclock secs/;
- is_deeply \@output, \@expected, '... and the output should be correct';
+ is_deeply \@output, \@expected, '... the output should be correct';
like $status, $expected_status,
'... and the status line should be correct';
like $summary, $expected_summary,
# normal tests with failures
@output = ();
- _runtests( $harness, "$source_tests/harness_failure" );
+ ok _runtests( $harness, "$source_tests/harness_failure" ),
+ 'Run tests with failures';
$status = pop @output;
$summary = pop @output;
- like $status, qr{^Result: FAIL$},
- '... and the status line should be correct';
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
- my @summary = @output[ 5 .. $#output ];
- @output = @output[ 0 .. 4 ];
+ my @summary = @output[ 9 .. $#output ];
+ @output = @output[ 0 .. 8 ];
@expected = (
"$source_tests/harness_failure ..",
'1..2',
'ok 1 - this is a test',
'not ok 2 - this is another test',
+ q{# Failed test 'this is another test'},
+ '# in harness_failure.t at line 5.',
+ q{# got: 'waffle'},
+ q{# expected: 'yarblokos'},
'Failed 1/2 subtests',
);
# quiet tests with failures
@output = ();
- _runtests( $harness_whisper, "$source_tests/harness_failure" );
+ ok _runtests( $harness_whisper, "$source_tests/harness_failure" ),
+ 'Run whisper tests with failures';
$status = pop @output;
$summary = pop @output;
'2',
);
- like $status, qr{^Result: FAIL$},
- '... and the status line should be correct';
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
is_deeply \@output, \@expected,
'... and failing test output should be correct';
# really quiet tests with failures
@output = ();
- _runtests( $harness_mute, "$source_tests/harness_failure" );
+ ok _runtests( $harness_mute, "$source_tests/harness_failure" ),
+ 'Run mute tests with failures';
$status = pop @output;
$summary = pop @output;
'2',
);
- like $status, qr{^Result: FAIL$},
- '... and the status line should be correct';
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
is_deeply \@output, \@expected,
'... and failing test output should be correct';
# only show directives
@output = ();
- _runtests(
+ ok _runtests(
$harness_directives,
"$source_tests/harness_directives"
- );
+ ),
+ 'Run tests with directives';
chomp(@output);
$summary = pop @output;
$expected_summary = qr/^Files=1, Tests=3, \d+ wallclock secs/;
- is_deeply \@output, \@expected, '... and the output should be correct';
+ is_deeply \@output, \@expected, '... the output should be correct';
like $summary, $expected_summary,
'... and the report summary should look correct';
# normal tests with bad tap
@output = ();
- _runtests( $harness, "$source_tests/harness_badtap" );
+ ok _runtests( $harness, "$source_tests/harness_badtap" ),
+ 'Run tests with bad TAP';
chomp(@output);
@output = map { trim($_) } @output;
'Failed 1/2 subtests',
);
is_deeply \@output, \@expected,
- '... and failing test output should be correct';
+ '... failing test output should be correct';
like $status, qr{^Result: FAIL$},
'... and the status line should be correct';
@expected_summary = (
# only show failures
@output = ();
- _runtests( $harness_failures, "$source_tests/harness_failure" );
+ ok _runtests( $harness_failures, "$source_tests/harness_failure" ),
+ 'Run tests with failures only';
chomp(@output);
$status = pop @output;
$summary = pop @output;
- like $status, qr{^Result: FAIL$},
- '... and the status line should be correct';
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
$expected_summary = qr/^Files=1, Tests=2, \d+ wallclock secs/;
is_deeply \@output, \@expected, '... and the output should be correct';
# check the status output for no tests
@output = ();
- _runtests( $harness_failures, "$sample_tests/no_output" );
+ ok _runtests( $harness_failures, "$sample_tests/no_output" ),
+ 'Run tests with failures';
chomp(@output);
$status = pop @output;
$summary = pop @output;
- like $status, qr{^Result: FAIL$},
- '... and the status line should be correct';
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
+ $expected_summary = qr/^Files=1, Tests=2, \d+ wallclock secs/;
+ is_deeply \@output, \@expected, '... and the output should be correct';
+
+ # coverage testing for _should_show_comments
+ # only show comments
+
+ @output = ();
+ ok _runtests( $harness_comments, "$source_tests/harness_failure" ),
+ 'Run tests with comments';
+ chomp(@output);
+
+ @expected = (
+ "$source_tests/harness_failure ..",
+ q{# Failed test 'this is another test'},
+ '# in harness_failure.t at line 5.',
+ q{# got: 'waffle'},
+ q{# expected: 'yarblokos'},
+ 'Failed 1/2 subtests',
+ 'Test Summary Report',
+ '-------------------',
+ "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
+ 'Failed test:',
+ '2',
+ );
+
+ $status = pop @output;
+ $summary = pop @output;
+
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
+ $expected_summary = qr/^Files=1, Tests=2, \d+ wallclock secs/;
+ is_deeply \@output, \@expected, '... and the output should be correct';
+
+ # coverage testing for _should_show_comments and _should_show_failures
+ # only show comments and failures
+
+ @output = ();
+ $ENV{FOO} = 1;
+ ok _runtests( $harness_fandc, "$source_tests/harness_failure" ),
+ 'Run tests with failures and comments';
+ delete $ENV{FOO};
+ chomp(@output);
+
+ @expected = (
+ "$source_tests/harness_failure ..",
+ 'not ok 2 - this is another test',
+ q{# Failed test 'this is another test'},
+ '# in harness_failure.t at line 5.',
+ q{# got: 'waffle'},
+ q{# expected: 'yarblokos'},
+ 'Failed 1/2 subtests',
+ 'Test Summary Report',
+ '-------------------',
+ "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
+ 'Failed test:',
+ '2',
+ );
+
+ $status = pop @output;
+ $summary = pop @output;
+
+ like $status, qr{^Result: FAIL$}, '... the status line should be correct';
$expected_summary = qr/^Files=1, Tests=2, \d+ wallclock secs/;
is_deeply \@output, \@expected, '... and the output should be correct';
my $sample_tests
= $ENV{PERL_CORE} ? '../ext/Test-Harness/t/sample-tests' : 't/sample-tests';
-plan tests => 113;
+plan tests => 119;
# note that this test will always pass when run through 'prove'
ok $ENV{HARNESS_ACTIVE}, 'HARNESS_ACTIVE env variable should be set';
'ok 1 - this is a test',
'[[reset]]',
'ok',
+ '[[green]]',
'All tests successful.',
+ '[[reset]]',
);
my $status = pop @output;
my $expected_status = qr{^Result: PASS$};
'ok 1 - this is a test',
'[[reset]]',
'ok',
+ '[[green]]',
'All tests successful.',
+ '[[reset]]',
);
$status = pop @output;
$expected_status = qr{^Result: PASS$};
'ok 1 - this is a test',
'[[reset]]',
'ok',
+ '[[green]]',
'All tests successful.',
+ '[[reset]]',
);
$status = pop @output;
$expected_status = qr{^Result: PASS$};
like $status, qr{^Result: FAIL$},
'... and the status line should be correct';
- my @summary = @output[ 10 .. $#output ];
- @output = @output[ 0 .. 9 ];
+ my @summary = @output[ 18 .. $#output ];
+ @output = @output[ 0 .. 17 ];
@expected = (
"$source_tests/harness_failure ..",
'[[red]]',
'not ok 2 - this is another test',
'[[reset]]',
+ q{# Failed test 'this is another test'},
+ '[[reset]]',
+ '# in harness_failure.t at line 5.',
+ '[[reset]]',
+ q{# got: 'waffle'},
+ '[[reset]]',
+ q{# expected: 'yarblokos'},
+ '[[reset]]',
'[[red]]',
'Failed 1/2 subtests',
);
is( $answer, "All tests successful.\n", 'cat meows' );
}
+# Exec with a coderef that returns an arrayref
+SKIP: {
+ my $cat = '/bin/cat';
+ unless ( -e $cat ) {
+ skip "no '$cat'", 2;
+ }
+
+ my $capture = IO::c55Capture->new_handle;
+ my $harness = TAP::Harness->new(
+ { verbosity => -2,
+ stdout => $capture,
+ exec => sub {
+ return [
+ $cat,
+ $ENV{PERL_CORE}
+ ? '../ext/Test-Harness/t/data/catme.1'
+ : 't/data/catme.1'
+ ];
+ },
+ }
+ );
+
+ _runtests( $harness, "$source_tests/harness" );
+
+ my @output = tied($$capture)->dump;
+ my $status = pop @output;
+ like $status, qr{^Result: PASS$},
+ '... and the status line should be correct';
+ pop @output; # get rid of summary line
+ my $answer = pop @output;
+ is( $answer, "All tests successful.\n", 'cat meows' );
+}
+
+# Exec with a coderef that returns raw TAP
+{
+ my $capture = IO::c55Capture->new_handle;
+ my $harness = TAP::Harness->new(
+ { verbosity => -2,
+ stdout => $capture,
+ exec => sub {
+ return "1..1\nok 1 - raw TAP\n";
+ },
+ }
+ );
+
+ _runtests( $harness, "$source_tests/harness" );
+
+ my @output = tied($$capture)->dump;
+ my $status = pop @output;
+ like $status, qr{^Result: PASS$},
+ '... and the status line should be correct';
+ pop @output; # get rid of summary line
+ my $answer = pop @output;
+ is( $answer, "All tests successful.\n", 'cat meows' );
+}
+
+# Exec with a coderef that returns a filehandle
+{
+ my $capture = IO::c55Capture->new_handle;
+ my $harness = TAP::Harness->new(
+ { verbosity => -2,
+ stdout => $capture,
+ exec => sub {
+ open my $fh,
+ $ENV{PERL_CORE}
+ ? '../ext/Test-Harness/t/data/catme.1'
+ : 't/data/catme.1';
+ return $fh;
+ },
+ }
+ );
+
+ _runtests( $harness, "$source_tests/harness" );
+
+ my @output = tied($$capture)->dump;
+ my $status = pop @output;
+ like $status, qr{^Result: PASS$},
+ '... and the status line should be correct';
+ pop @output; # get rid of summary line
+ my $answer = pop @output;
+ is( $answer, "All tests successful.\n", 'cat meows' );
+}
+
# catches "exec accumulates arguments" issue (r77)
{
my $capture = IO::c55Capture->new_handle;
{ source => File::Spec->catfile(
( $ENV{PERL_CORE}
? ( File::Spec->updir(), 'ext',
- 'Test-Harness'
+ 'Test-Harness'
)
: ()
),
}
}
-use Test::More tests => 282;
+use Test::More tests => 294;
use IO::c55Capture;
use File::Spec;
is scalar $parser->passed, 2,
'Empty junk lines should not affect the correct number of tests passed';
+# Check source => "tap content"
+can_ok $PARSER, 'new';
+$parser = $PARSER->new( { source => "1..1\nok 1\n" } );
+isa_ok $parser, $PARSER, '... and calling it should succeed';
+ok @results = _get_results($parser), 'The parser should return results';
+is( scalar @results, 2, "Got two lines of TAP" );
+
+# Check source => [array]
+can_ok $PARSER, 'new';
+$parser = $PARSER->new( { source => [ "1..1", "ok 1" ] } );
+isa_ok $parser, $PARSER, '... and calling it should succeed';
+ok @results = _get_results($parser), 'The parser should return results';
+is( scalar @results, 2, "Got two lines of TAP" );
+
+# Check source => $filehandle
+can_ok $PARSER, 'new';
+open my $fh, $ENV{PERL_CORE}
+ ? '../ext/Test-Harness/t/data/catme.1'
+ : 't/data/catme.1';
+$parser = $PARSER->new( { source => $fh } );
+isa_ok $parser, $PARSER, '... and calling it should succeed';
+ok @results = _get_results($parser), 'The parser should return results';
+is( scalar @results, 2, "Got two lines of TAP" );
+
{
# set a spool to write to
use App::Prove;
# Change PERL5LIB so we ensure it's preserved.
-$ENV{PERL5LIB} = join( $path_sep, 'wibble',
- ($ENV{PERL_CORE} ? '../lib' : ()), $ENV{PERL5LIB} || '' );
+$ENV{PERL5LIB} = join(
+ $path_sep, 'wibble',
+ ( $ENV{PERL_CORE} ? '../lib' : () ), $ENV{PERL5LIB} || ''
+);
open TEST, ">perl5lib_check.t.tmp";
print TEST <<"END";
],
},
+ # .proverc
+ { name => 'Empty exec in .proverc',
+ args => {
+ argv => [qw( one two three )],
+ },
+ proverc => $ENV{PERL_CORE} ? '../ext/Test-Harness/t/proverc/emptyexec' : 't/proverc/emptyexec',
+ switches => [$dummy_test],
+ expect => { exec => '' },
+ runlog => [
+ [ '_runtests',
+ { exec => [],
+ verbosity => 0,
+ show_count => 1,
+ },
+ 'TAP::Harness',
+ $dummy_test
+ ]
+ ],
+ },
+
# Executing one word (why would it be a -s though?)
{ name => 'Switch --exec -s',
args => {
# Optionally parse command args
if ( my $switches = $test->{switches} ) {
+ if ( my $proverc = $test->{proverc} ) {
+ $app->add_rc_file( File::Spec->catfile( split /\//, $proverc ) );
+ }
eval { $app->process_args( '--norc', @$switches ) };
if ( my $err_pattern = $test->{parse_error} ) {
like $@, $err_pattern, "$name: expected parse error";
my $expect = $test->{expect} || {};
for my $attr ( sort @ATTR ) {
- my $val = $app->$attr();
- my $assertion = $expect->{$attr} || $DEFAULT_ASSERTION{$attr};
- my $is_ok = undef;
+ my $val = $app->$attr();
+ my $assertion
+ = exists $expect->{$attr}
+ ? $expect->{$attr}
+ : $DEFAULT_ASSERTION{$attr};
+ my $is_ok = undef;
if ( 'CODE' eq ref $assertion ) {
$is_ok = ok $assertion->( $val, $attr ),
--- /dev/null
+--exec ''
+
passed => TRUE,
is_ok => TRUE,
directive => 'SKIP',
- explanation => ''
+ explanation => 'rope'
},
],
plan => '1..0',
'exit' => 0,
wait => 0,
version => 12,
- skip_all => '(no reason given)',
+ skip_all => 'rope',
},
skipall_v13 => {
results => [
wait => 0,
version => 12,
},
+
+ zero_valid => {
+ results => [
+ { is_plan => TRUE,
+ raw => '1..5',
+ tests_planned => 5,
+ passed => TRUE,
+ is_ok => TRUE,
+ },
+ { actual_passed => TRUE,
+ is_actual_ok => TRUE,
+ description => '- One',
+ passed => TRUE,
+ is_ok => TRUE,
+ is_test => TRUE,
+ has_skip => FALSE,
+ has_todo => FALSE,
+ number => 1,
+ is_unplanned => FALSE,
+ },
+ { actual_passed => TRUE,
+ is_actual_ok => TRUE,
+ description => '- Two',
+ passed => TRUE,
+ is_ok => TRUE,
+ is_test => TRUE,
+ has_skip => FALSE,
+ has_todo => FALSE,
+ number => 2,
+ is_unplanned => FALSE,
+ },
+ { actual_passed => TRUE,
+ is_actual_ok => TRUE,
+ description => '- Three',
+ passed => TRUE,
+ is_ok => TRUE,
+ is_test => TRUE,
+ has_skip => FALSE,
+ has_todo => FALSE,
+ number => 3,
+ is_unplanned => FALSE,
+ },
+ { actual_passed => TRUE,
+ is_actual_ok => TRUE,
+ description => '- Four',
+ passed => TRUE,
+ is_ok => TRUE,
+ is_test => TRUE,
+ has_skip => FALSE,
+ has_todo => FALSE,
+ number => 0,
+ is_unplanned => FALSE,
+ },
+ { actual_passed => TRUE,
+ is_actual_ok => TRUE,
+ description => '- Five',
+ passed => TRUE,
+ is_ok => TRUE,
+ is_test => TRUE,
+ has_skip => FALSE,
+ has_todo => FALSE,
+ number => 5,
+ is_unplanned => FALSE,
+ },
+ ],
+ plan => '1..5',
+ passed => [ 1 .. 3, 0, 5 ],
+ actual_passed => [ 1 .. 3, 0, 5 ],
+ failed => [],
+ actual_failed => [],
+ todo => [],
+ todo_passed => [],
+ skipped => [],
+ good_plan => TRUE,
+ is_good_plan => TRUE,
+ tests_planned => 5,
+ tests_run => 5,
+ parse_errors => [
+ 'Tests out of sequence. Found (0) but expected (4)',
+ ],
+ 'exit' => 0,
+ wait => 0,
+ version => 12,
+ },
);
my %HANDLER_FOR = (
--- /dev/null
+print <<DUMMY;
+1..5
+ok 1 - One
+ok 2 - Two
+ok - Three
+ok 0 - Four
+ok 5 - Five
+DUMMY
1..2
ok 1 - this is a test
not ok 2 - this is another test
+# Failed test 'this is another test'
+# in harness_failure.t at line 5.
+# got: 'waffle'
+# expected: 'yarblokos'
END_TESTS
projects / platform / upstream / perl.git / commitdiff