Re: actually using the distgen chdir enhancements
[email protected] (David E . Wheeler)
| Newsgroups | perl.module.build |
|---|---|
| Message-ID | <[email protected]> |
On Jul 9, 2008, at 09:55, David E. Wheeler wrote:
>>> Yes, you fixed it. Thanks! I'll submit a new patch for the
>>> TAP::Harness stuff alone today.
And here it is. Executive summary cribbed from before:
> * Documents the `test_file_exts` property and makes it actually
> work. Note that, as a side-effect, `test_types` now can optionally
> specify arrays of extensions. :-) I also added a test for
> `test_file_exts`. N.B.: I recommend passing `quiet => 1` to your MB
> objects in tests to keep them from emitting stuff that potentially
> could confuse the TAP parser. Right now a fair number of tests emit
> a lot of extra stuff. Try running `/Build test --test_files t/
> runthrough.t --verbose` to see what I mean.
This is still true, BTW.
> * Adds the `use_tap_harness` property. This forces Module::Build to
> use TAP::Harness to run tests instead of Test::Harness. This is
> potentially very powerful, because it gives uses much more control
> over their test environments, thanks to the other new property…
And I changed the default value from `{}` to 0.
> * Adds the `tap_harness_args` property, which is a hash reference of
> parameters to be passed to `TAP::Harness->new`. Note that the
> presence of this property implicitly sets `use_tap_harness` to a
> true value. See the new `t/use_tap_harness.t` test for an example.
>
> * Separates the running of the harnesses from the rest of the test
> setup by dispatching to two new methods, as appropriate:
> `run_test_harness`, `run_tap_harness`, and `run_visual_script`. I
> just felt that it was better to encapsulate these specific tasks;
> they'll also make it easier for subclasses to tweak things, should
> they need to do so.
>
> I documented the new and updated properties in Module::Build::API
> (please check my version numbers there, I'm confused as to what will
> be the next version of MB). Let me know if I should document them
> elsewhere, as well. FWIW, I think that providing this interface to
> TAP::Harness will offer much more of the flexibility that users
> might require than the experimental `test_types` property, but
> that's just my humble opinion, of course.
Again, let me know if you see any other issues.
Thanks!
David
tap-harness-v2.patch.txt
(text/plain, 11.1 KB)
Index: t/test_file_exts.t
===================================================================
--- t/test_file_exts.t (revision 0)
+++ t/test_file_exts.t (revision 0)
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 5;
+use DistGen;
+
+use_ok 'Module::Build';
+ensure_blib('Module::Build');
+
+my $tmp = MBTest->tmpdir;
+my $dist = DistGen->new( dir => $tmp );
+
+$dist->add_file('t/mytest.s', <<'---' );
+#!perl
+use Test::More tests => 2;
+ok(1, 'first mytest.s');
+ok(1, 'second mytest.s');
+---
+
+$dist->regen;
+$dist->chdir_in;
+
+#########################
+
+# So make sure that the test gets run with the alternate extension.
+ok my $mb = Module::Build->new(
+ module_name => $dist->name,
+ test_file_exts => ['.s'],
+ 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 - FIRST MYTEST[.]S/m, 'Should see first test output';
+like $out, qr/^OK 2 - SECOND MYTEST[.]S/m, 'Should see second test output';
+
+# Cleanup.
+$dist->remove;
+
+# vim:ts=4:sw=4:et:sta
Index: t/use_tap_harness.t
===================================================================
--- t/use_tap_harness.t (revision 0)
+++ t/use_tap_harness.t (revision 0)
@@ -0,0 +1,62 @@
+#!/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';
+
+# Cleanup.
+$dist->remove;
+
+# vim:ts=4:sw=4:et:sta
Index: lib/Module/Build/Base.pm
===================================================================
--- lib/Module/Build/Base.pm (revision 11504)
+++ lib/Module/Build/Base.pm (working copy)
@@ -740,6 +740,10 @@
# If there was no orig_dir, set to the same as base_dir
$self->{properties}{orig_dir} ||= $self->{properties}{base_dir};
+ # If there are tap_harness_args, then we need to use_tap_harness.
+ $self->{properties}{use_tap_harness} ||=
+ exists $self->{properties}{tap_harness_args};
+
my $defaults = $self->valid_properties_defaults;
foreach my $prop (keys %$defaults) {
@@ -776,6 +780,9 @@
__PACKAGE__->add_property(create_packlist => 1);
__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};
@@ -2103,7 +2110,7 @@
@types or croak "need some types of tests to check";
my %test_types = (
- default => '.t',
+ default => $p->{test_file_exts},
(defined($p->{test_types}) ? %{$p->{test_types}} : ()),
);
@@ -2113,7 +2120,7 @@
}
# we use local here because it ends up two method calls deep
- local $p->{test_file_exts} = [ @test_types{@types} ];
+ local $p->{test_file_exts} = [ map { ref $_ ? @$_ : $_ } @test_types{@types} ];
$self->depends_on('code');
# Protect others against our @INC changes
@@ -2132,42 +2139,70 @@
sub do_tests {
my $self = shift;
- my $p = $self->{properties};
- require Test::Harness;
+ my $tests = $self->find_test_files;
- # 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;
+ if (@$tests) {
+ if ($self->use_tap_harness) {
+ $self->run_tap_harness( $tests );
+ } else {
+ $self->run_test_harness( $tests );
+ }
+ } else {
+ $self->log_info("No tests defined.\n");
+ }
- my $tests = $self->find_test_files;
+ $self->run_visual_script;
+}
- if (@$tests) {
+sub run_tap_harness {
+ my ($self, $tests) = @_;
+ require TAP::Harness;
+ TAP::Harness->new({
+ 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 {
my $self = shift;
my $p = $self->{properties};
@@ -2179,7 +2214,7 @@
sub expand_test_dir {
my ($self, $dir) = @_;
- my $exts = $self->{properties}{test_file_exts} || ['.t'];
+ my $exts = $self->{properties}{test_file_exts};
return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts
if $self->recursive_test_files;
Index: lib/Module/Build/API.pod
===================================================================
--- lib/Module/Build/API.pod (revision 11504)
+++ lib/Module/Build/API.pod (working copy)
@@ -725,7 +725,27 @@
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
[version 0.19]
Index: lib/Module/Build.pm
===================================================================
--- lib/Module/Build.pm (revision 11504)
+++ lib/Module/Build.pm (working copy)
@@ -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>.
@@ -554,6 +554,14 @@
If you want to run tests under the perl debugger, pass the argument
C<debugger=1>.
+If you want to have Module::Build find test files with different file
+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<test_params> 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
@@ -597,7 +605,7 @@
...
test_types => {
special => '.st',
- author => '.at',
+ author => ['.at', '.pt' ],
},
...