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


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} = [ @[EMAIL PROTECTED] ];
+  local $p->{test_file_exts} = [ map { ref $_ ? @$_ : $_ } @[EMAIL PROTECTED] 
];
   $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' ],
     },
     ...
 

Reply via email to