Author: dagolden
Date: Sun Aug 30 18:26:43 2009
New Revision: 13237
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/t/lib/DistGen.pm
Module-Build/trunk/t/use_tap_harness.t
Log:
die on test failure when using TAP::Harness
Test::Harness dies on failure but TAP::Harness does not. We now
emulate this behavior of Test::Harness when running tests with
TAP::Harness. The change happens in do_tests() so that subclasses
may call run_tap_harness() and get back the TAP::Parser::Aggregator
object directly for more sophisticated testing and analysis.
I also added tests for this new behavior and did some minor cleanup
of t/use_tap_harness.t along the way.
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Sun Aug 30 18:26:43 2009
@@ -14,6 +14,9 @@
- Fix the t/destinations.t fix. [David Golden, with thanks to Eric Wilhelm]
- Fix recursive test files in generated Makefile.PL (RT#49254) [Sawyer X]
- Guard against trying :utf8 when :utf8 isn't available
+ - The "test" action now dies when using the 'use_tap_harness'
+ option and tests fail, matching the behavior under Test::Harness.
+ (RT#49080) [initial patch from David Wheeler; revised by David Golden]
0.35 - Thu Aug 27 09:12:02 EDT 2009
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 Sun Aug 30 18:26:43 2009
@@ -2276,6 +2276,8 @@
$self->do_tests;
}
+# Test::Harness dies on failure but TAP::Harness does not, so we must
+# die if running under TAP::Harness
sub do_tests {
my $self = shift;
@@ -2284,7 +2286,8 @@
if(@$tests) {
my $args = $self->tap_harness_args;
if($self->use_tap_harness or ($args and %$args)) {
- $self->run_tap_harness($tests);
+ my $aggregate = $self->run_tap_harness($tests);
+ $self->_tap_harness_exit($aggregate) if $aggregate->has_errors;
}
else {
$self->run_test_harness($tests);
@@ -2304,12 +2307,36 @@
# TODO allow the test @INC to be set via our API?
- TAP::Harness->new({
+ my $aggregate = TAP::Harness->new({
lib => [...@inc],
verbosity => $self->{properties}{verbose},
switches => [ $self->harness_switches ],
%{ $self->tap_harness_args },
})->runtests(@$tests);
+
+ return $aggregate;
+}
+
+# Emulate death on failure behavior of Test::Harness
+sub _tap_harness_exit {
+ my ($self, $aggregate) = @_;
+
+ my $total = $aggregate->total;
+ my $passed = $aggregate->passed;
+ my $failed = $aggregate->failed;
+
+ my @parsers = $aggregate->parsers;
+
+ my $num_bad = 0;
+ for my $parser (@parsers) {
+ $num_bad++ if $parser->has_problems;
+ }
+
+ die(sprintf(
+ "Failed %d/%d test programs. %d/%d subtests failed.\n",
+ $num_bad, scalar @parsers, $failed, $total
+ )
+ ) if $num_bad;
}
sub run_test_harness {
Modified: Module-Build/trunk/t/lib/DistGen.pm
==============================================================================
--- Module-Build/trunk/t/lib/DistGen.pm (original)
+++ Module-Build/trunk/t/lib/DistGen.pm Sun Aug 30 18:26:43 2009
@@ -428,7 +428,9 @@
}
sub change_build_pl {
- my ($self, $opts) = @_;
+ my ($self, @opts) = @_;
+
+ my $opts = ref $opts[0] eq 'HASH' ? $opts[0] : { @opts };
local $Data::Dumper::Terse = 1;
(my $args = Dumper($opts)) =~ s/^\s*\{|\}\s*$//g;
Modified: Module-Build/trunk/t/use_tap_harness.t
==============================================================================
--- Module-Build/trunk/t/use_tap_harness.t (original)
+++ Module-Build/trunk/t/use_tap_harness.t Sun Aug 30 18:26:43 2009
@@ -4,7 +4,7 @@
use Test::More;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
if (eval { require TAP::Harness } && TAP::Harness->VERSION >= 3) {
- plan tests => 8;
+ plan tests => 11;
} else {
plan skip_all => 'TAP::Harness 3+ not installed'
}
@@ -17,16 +17,20 @@
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(
+$dist->change_build_pl(
module_name => $dist->name,
use_tap_harness => 1,
quiet => 1,
-), 'Construct build object with test_file_exts parameter';
+);
+$dist->regen;
+
+ok my $mb = $dist->new_from_context,
+ '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
@@ -40,12 +44,16 @@
#########################
# Make sure that arguments are passed through to TAP::Harness.
-ok $mb = Module::Build->new(
+$dist->change_build_pl(
module_name => $dist->name,
use_tap_harness => 1,
tap_harness_args => { verbosity => 0 },
quiet => 1,
-), 'Construct build object with test_file_exts parameter';
+);
+$dist->regen;
+
+ok $mb = $dist->new_from_context,
+ '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
@@ -56,6 +64,35 @@
unlike $out, qr/^OK 1/m, 'Should not see first test output';
like $out, qr/^ALL TESTS SUCCESSFUL/m, 'Should see test success message';
+#--------------------------------------------------------------------------#
+# test that a failing test dies
+#--------------------------------------------------------------------------#
+
+$dist->change_build_pl(
+ module_name => $dist->name,
+ use_tap_harness => 1,
+ tap_harness_args => { verbosity => 1 },
+ quiet => 1,
+);
+$dist->change_file('t/basic.t',<<"---");
+use Test::More tests => 1;
+use strict;
+
+use $dist->{name};
+ok 0;
+---
+$dist->regen;
+
+ok $mb = $dist->new_from_context,
+ 'Construct build object after setting tests to fail';
+# Use uc() so we don't confuse the current test output
+my $out = stdout_stderr_of( sub { $dist->run_build('test')} );
+ok( $?, "'Build test' had non-zero exit code" );
+like( $out, qr{Failed 1/1 test programs. 1/1 subtests failed\.},
+ "Saw emulated Test::Harness die() message"
+);
+
+
$dist->remove;
# vim:ts=4:sw=4:et:sta
