Re: Subclass? Plugin? Mixin? Monkey Patch?
[email protected] (David E . Wheeler)
| Newsgroups | perl.module.build |
|---|---|
| Message-ID | <[email protected]> |
On Jun 18, 2008, at 11:07, Eric Wilhelm wrote: >> Link? > > http://www.nntp.perl.org/group/perl.module.build/2008/03/msg1298.html Wow, that's pretty comprehensive. I'm afraid that I'm much too lazy to implement plugins as described there. Besides, to get Module::Build to do what I want, I'd still have to rewrite `do_tests()`, which would rather defeat the purpose. But just FYI, you might want to take a look at the simple plugin architecture I added to SVN::Notify in 2.70, where it's called "filters". You can read about its interface here: http://search.cpan.org/perldoc?SVN::Notify::Filter Basically, a filter author just has to implement a module with subroutines named according to the methods they plugin to. There is no other magic than requiring that the sub names come from a predefined list, and that, if an author puts the module under the SVN::Notify::Filter namespace, then it's easier for users to use (they don't have to specify the entire package name to tell SVN::Notify to use the filter). Dead simple and it was pretty easy to implement. The requirements for Module::Build plugins seem a bit more complex, so you probably would have to be more stringent in how arguments and return values are handled. But anyway, what I've done instead is to patch Module::Build directly to get it to use optionally use TAP::Harness instead of Test::Harness. Yes, I'm changing `do_tests` directly. :-) The attached patch also does a couple of other minor things. Here's a complete description: * Fixes a shitload of warnings during testing by changing the cwd in MBTest and DistGen. For my install of File::Path on Perl 5.10, it won't actually delete a directory if your current cwd is unknown. So I added appropriate calls to `chdir` when `Cwd::getcwd` returns false. And now all tests pass for me. * 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. * 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… * 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. Let me know what you think, and whether I should change anything in order to get this committed. Oh, and BTW, when is the next version due to be released? Is the version on CPAN *still* older than the one that ships with Perl 5.10? Best, David PS: With this patch, Module::Build will have over 1000 tests. W00t!
tap-harness.patch.txt
(text/plain, 12.1 KB)
Index: t/lib/DistGen.pm
===================================================================
--- t/lib/DistGen.pm (revision 11437)
+++ t/lib/DistGen.pm (working copy)
@@ -364,6 +364,10 @@
sub remove {
my $self = shift;
croak("invalid usage -- remove()") if(@_);
+ unless (Cwd::getcwd) {
+ # How'd we get here?
+ chdir '..' or die "Couldn't chdir to ..";
+ }
File::Path::rmtree( $self->dirname );
}
Index: t/lib/MBTest.pm
===================================================================
--- t/lib/MBTest.pm (revision 11437)
+++ t/lib/MBTest.pm (working copy)
@@ -69,7 +69,9 @@
sub tmpdir { $tmp }
END {
if(-d $tmp) {
- File::Path::rmtree($tmp) or warn "cannot clean dir '$tmp'";
+ # Go back to where you came from!
+ chdir '..' or die "Couldn't chdir to $cwd";
+ File::Path::rmtree($tmp) or diag "cannot clean dir '$tmp': $@";
}
}
}
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;
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+#########################
+
+# 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,63 @@
+#!/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;
+
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+#########################
+
+# 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 11437)
+++ 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 => {});
+__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 11437)
+++ 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 11437)
+++ 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' ],
},
...