Author: ericwilhelm
Date: Wed Jul 9 16:10:12 2008
New Revision: 11509
Added:
Module-Build/trunk/t/use_tap_harness.t
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/MANIFEST
Module-Build/trunk/lib/Module/Build.pm
Module-Build/trunk/lib/Module/Build/API.pod
Module-Build/trunk/lib/Module/Build/Base.pm
Log:
** added support for TAP::Harness - mostly via patch from David Wheeler
t/use_tap_harness.t - purports to provide coverage (@INC bits and switches
probably not so much)
lib/Module/Build/Base.pm - use_tap_harness+tap_harness_args properties,
refactor in do_tests() => run_test_harness() + run_visual_script(),
added run_tap_harness(),
--use-tap-harness + --tap-harness-args command-line options
lib/Module/Build/API.pod - documentation for use_tap_harness &c
lib/Module/Build.pm - mentioning TAP::Harness support
MANIFEST - regen
Changes - update
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Wed Jul 9 16:10:12 2008
@@ -1,11 +1,7 @@
Revision history for Perl extension Module::Build.
- - Added test_file_exts property for main-run tests other than '*.t'.
- [David Wheeler]
-
- - Fixed getcwd()/rmtree() failure case on 5.10+mac where something is
- unhappy about all of the tests deleting their distgen directory
- before leaving it. [Eric Wilhelm & David Wheeler]
+ - Experimental support for TAP::Harness with --use-tap-harness option
+ and the tap_harness_args property. [David Wheeler & Eric Wilhelm]
- Improved support for parsing qv() in modules' $VERSION
declarations, and made $VERSION-parsing errors more verbose. [Jos
Modified: Module-Build/trunk/MANIFEST
==============================================================================
--- Module-Build/trunk/MANIFEST (original)
+++ Module-Build/trunk/MANIFEST Wed Jul 9 16:10:12 2008
@@ -67,5 +67,6 @@
t/test_type.t
t/test_types.t
t/tilde.t
+t/use_tap_harness.t
t/versions.t
t/xs.t
Modified: Module-Build/trunk/lib/Module/Build.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build.pm (original)
+++ Module-Build/trunk/lib/Module/Build.pm Wed Jul 9 16:10:12 2008
@@ -543,10 +543,10 @@
[version 0.01]
-This will use C<Test::Harness> to run any regression tests and report
-their results. Tests can be defined in the standard places: a file
-called C<test.pl> in the top-level directory, or several files ending
-with C<.t> in a C<t/> directory.
+This will use C<Test::Harness> or C<TAP::Harness> to run any regression
+tests and report their results. Tests can be defined in the standard
+places: a file called C<test.pl> in the top-level directory, or several
+files ending with C<.t> in a C<t/> directory.
If you want tests to be 'verbose', i.e. show details of test execution
rather than just summary information, pass the argument C<verbose=1>.
@@ -558,6 +558,10 @@
name extensions, pass the C<test_file_exts> argument with an array
of extensions, such as C<[qw( .t .s .z )]>.
+If you want test to be run by C<TAP::Harness>, rather than C<Test::Harness>,
+pass the argument C<tap_harness_args> as an array reference of arguments to
+pass to the TAP::Harness constructor.
+
In addition, if a file called C<visual.pl> exists in the top-level
directory, this file will be executed as a Perl script and its output
will be shown to the user. This is a good place to put speed tests or
Modified: Module-Build/trunk/lib/Module/Build/API.pod
==============================================================================
--- Module-Build/trunk/lib/Module/Build/API.pod (original)
+++ Module-Build/trunk/lib/Module/Build/API.pod Wed Jul 9 16:10:12 2008
@@ -725,6 +725,26 @@
property is true, then the C<t/> directory will be scanned recursively
for C<*.t> files.
+=item use_tap_harness
+
+[version 0.2808_03]
+
+An optional parameter indicating whether or not to use TAP::Harness for
+testing rather than Test::Harness. Defaults to false. If set to true, you must
+therefore be sure to add TAP::Harness as a requirement for your module in
+L</build_requires>. Implicitly set to a true value if C<tap_harness_args> is
+specified.
+
+=item tap_harness_args
+
+[version 0.2808_03]
+
+An optional parameter specifying parameters to be passed to TAP::Harness when
+running tests. Must be given as a hash reference of parameters; see the
+L<TAP::Harness|TAP::Harness> documentation for details. Note that specifying
+this parameter will implicitly set C<use_tap_harness> to a true value. You
+must therefore be sure to add TAP::Harness as a requirement for your module in
+L</build_requires>.
=item xs_files
Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Wed Jul 9 16:10:12 2008
@@ -777,6 +777,8 @@
__PACKAGE__->add_property(allow_mb_mismatch => 0);
__PACKAGE__->add_property(config => undef);
__PACKAGE__->add_property(test_file_exts => ['.t']);
+__PACKAGE__->add_property(use_tap_harness => 0);
+__PACKAGE__->add_property(tap_harness_args => {});
{
my $Is_ActivePerl = eval {require ActivePerl::DocTools};
@@ -1568,6 +1570,8 @@
return $self->{args}{$key};
}
+# allows select parameters (with underscores) to be spoken with dashes
+# when used as command-line options
sub _translate_option {
my $self = shift;
my $opt = shift;
@@ -1586,6 +1590,8 @@
meta_merge
test_files
use_rcfile
+ use_tap_harness
+ tap_harness_args
); # normalize only selected option names
return $opt;
@@ -1620,6 +1626,7 @@
uninst
use_rcfile
verbose
+ use_tap_harness
);
# inverted boolean options; eg --noverbose or --no-verbose
@@ -2140,40 +2147,77 @@
sub do_tests {
my $self = shift;
- my $p = $self->{properties};
- require Test::Harness;
-
- # Do everything in our power to work with all versions of Test::Harness
- my @harness_switches = $p->{debugger} ? qw(-w -d) : ();
- local $Test::Harness::switches = join ' ', grep defined,
$Test::Harness::switches, @harness_switches;
- local $Test::Harness::Switches = join ' ', grep defined,
$Test::Harness::Switches, @harness_switches;
- local $ENV{HARNESS_PERL_SWITCHES} = join ' ', grep defined,
$ENV{HARNESS_PERL_SWITCHES}, @harness_switches;
-
- $Test::Harness::switches = undef unless length $Test::Harness::switches;
- $Test::Harness::Switches = undef unless length $Test::Harness::Switches;
- delete $ENV{HARNESS_PERL_SWITCHES} unless length $ENV{HARNESS_PERL_SWITCHES};
-
- local ($Test::Harness::verbose,
- $Test::Harness::Verbose,
- $ENV{TEST_VERBOSE},
- $ENV{HARNESS_VERBOSE}) = ($p->{verbose} || 0) x 4;
my $tests = $self->find_test_files;
- if (@$tests) {
+ if(@$tests) {
+ my $args = $self->tap_harness_args;
+ if($self->use_tap_harness or ($args and %$args)) {
+ $self->run_tap_harness($tests);
+ }
+ else {
+ $self->run_test_harness($tests);
+ }
+ }
+ else {
+ $self->log_info("No tests defined.\n");
+ }
+
+ $self->run_visual_script;
+}
+
+sub run_tap_harness {
+ my ($self, $tests) = @_;
+
+ require TAP::Harness;
+
+ # TODO allow the test @INC to be set via our API?
+
+ TAP::Harness->new({
+ lib => [EMAIL PROTECTED],
+ verbosity => $self->{properties}{verbose},
+ switches => [ $self->harness_switches ],
+ %{ $self->tap_harness_args },
+ })->runtests(@$tests);
+}
+
+sub run_test_harness {
+ my ($self, $tests) = @_;
+ require Test::Harness;
+ my $p = $self->{properties};
+ my @harness_switches = $self->harness_switches;
+
# Work around a Test::Harness bug that loses the particular perl
# we're running under. $self->perl is trustworthy, but $^X isn't.
local $^X = $self->perl;
+
+ # Do everything in our power to work with all versions of Test::Harness
+ local $Test::Harness::switches = join ' ', grep defined,
$Test::Harness::switches, @harness_switches;
+ local $Test::Harness::Switches = join ' ', grep defined,
$Test::Harness::Switches, @harness_switches;
+ local $ENV{HARNESS_PERL_SWITCHES} = join ' ', grep defined,
$ENV{HARNESS_PERL_SWITCHES}, @harness_switches;
+
+ $Test::Harness::switches = undef unless length $Test::Harness::switches;
+ $Test::Harness::Switches = undef unless length $Test::Harness::Switches;
+ delete $ENV{HARNESS_PERL_SWITCHES} unless length
$ENV{HARNESS_PERL_SWITCHES};
+
+ local ($Test::Harness::verbose,
+ $Test::Harness::Verbose,
+ $ENV{TEST_VERBOSE},
+ $ENV{HARNESS_VERBOSE}) = ($p->{verbose} || 0) x 4;
+
Test::Harness::runtests(@$tests);
- } else {
- $self->log_info("No tests defined.\n");
- }
+}
- # This will get run and the user will see the output. It doesn't
- # emit Test::Harness-style output.
- if (-e 'visual.pl') {
- $self->run_perl_script('visual.pl', '-Mblib='.$self->blib);
- }
+sub run_visual_script {
+ my $self = shift;
+ # This will get run and the user will see the output. It doesn't
+ # emit Test::Harness-style output.
+ $self->run_perl_script('visual.pl', '-Mblib='.$self->blib)
+ if -e 'visual.pl';
+}
+
+sub harness_switches {
+ shift->{properties}{debugger} ? qw(-w -d) : ();
}
sub test_files {
Added: Module-Build/trunk/t/use_tap_harness.t
==============================================================================
--- (empty file)
+++ Module-Build/trunk/t/use_tap_harness.t Wed Jul 9 16:10:12 2008
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+if (eval { require TAP::Parser }) {
+ plan tests => 8;
+} else {
+ plan skip_all => 'TAP::Parser not installed'
+}
+
+use MBTest;
+use DistGen;
+
+use_ok 'Module::Build';
+ensure_blib('Module::Build');
+my $tmp = MBTest->tmpdir;
+my $dist = DistGen->new( dir => $tmp );
+$dist->regen;
+
+$dist->chdir_in;
+#########################
+
+# Make sure that TAP::Harness properly does its thing.
+ok my $mb = Module::Build->new(
+ module_name => $dist->name,
+ use_tap_harness => 1,
+ quiet => 1,
+), 'Construct build object with test_file_exts parameter';
+
+$mb->add_to_cleanup('save_out');
+# Use uc() so we don't confuse the current test output
+my $out = uc(stdout_of(
+ sub {$mb->dispatch('test', verbose => 1)}
+));
+
+like $out, qr/^OK 1/m, 'Should see first test output';
+like $out, qr/^ALL TESTS SUCCESSFUL/m, 'Should see test success message';
+
+#########################
+
+# Make sure that arguments are passed through to TAP::Harness.
+ok $mb = Module::Build->new(
+ module_name => $dist->name,
+ use_tap_harness => 1,
+ tap_harness_args => { verbosity => 0 },
+ quiet => 1,
+), 'Construct build object with test_file_exts parameter';
+
+$mb->add_to_cleanup('save_out');
+# Use uc() so we don't confuse the current test output
+$out = uc(stdout_of(
+ sub {$mb->dispatch('test', verbose => 1)}
+));
+
+unlike $out, qr/^OK 1/m, 'Should not see first test output';
+like $out, qr/^ALL TESTS SUCCESSFUL/m, 'Should see test success message';
+
+$dist->remove;
+
+# vim:ts=4:sw=4:et:sta
