| Subject: | Show exceptions from Nested tests |
Test::Aggregate::Nested is swallowing exceptions
thrown by the .t files which makes it hard to debug those tests.
I think this was merely an oversight as there already was an 'eval ...
diag($@)' present,
but the errors from `do $file` aren't progating to that.
`perldoc -f do` describes a dance with $@ and $!.
I also found a few surprises with the exceptions used for skipping tests.
So I apologize for what appears to be a bit of a large patch
but there's not really that much happening there.
I could submit this as a pull req (or a series of patches (via git
format-patch)) if you prefer.
Do you think this is appropriate?
In my experience it didn't change the output of the rest of the test suite.
Thanks!
| Subject: | test-agg-diag-exceptions.patch |
diff --git a/aggtests-exception/die.t b/aggtests-exception/die.t
new file mode 100644
index 0000000..54af601
--- /dev/null
+++ b/aggtests-exception/die.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+ok 1, "$0 ***** 1";
+
+die "Ensure exceptions are not hidden during aggregate tests";
+
+done_testing();
diff --git a/lib/Test/Aggregate.pm b/lib/Test/Aggregate.pm
index 80d6701..af1f108 100644
--- a/lib/Test/Aggregate.pm
+++ b/lib/Test/Aggregate.pm
@@ -361,7 +361,7 @@ sub run_this_test_program {
$builder->{'Test::Aggregate::Builder'}{file_for}{$package} = $test;
local $builder->{'Test::Aggregate::Builder'}{running} = $package;
eval { $package->run_the_tests };
- if ($@ && $@ == $Test::Aggregate::Builder::skip) {
+ if ($@ && ref($@) && $@ == $Test::Aggregate::Builder::skip) {
$builder->skip( $builder->{'Test::Aggregate::Builder'}{skip_all}{$package} );
return;
}
diff --git a/lib/Test/Aggregate/Nested.pm b/lib/Test/Aggregate/Nested.pm
index 703735d..6168b59 100644
--- a/lib/Test/Aggregate/Nested.pm
+++ b/lib/Test/Aggregate/Nested.pm
@@ -145,7 +145,7 @@ sub run {
}
eval <<" END";
package $package;
- Test::Aggregate::Nested::subtest("Tests for $test", sub { do \$test });
+ Test::Aggregate::Nested::_do_file_as_subtest(\$test);
END
diag $@ if $@;
$test_phase{teardown}->($test);
@@ -155,6 +155,38 @@ sub run {
sub run_this_test_program { }
+sub _do_file_as_subtest {
+ my ($test) = @_;
+ subtest("Tests for $test", sub {
+ my $error;
+ {
+ local ($@, $!);
+ # if do("file") fails it will return undef (and set $@ or $!)
+ unless(defined( my $return = do $test )){
+ # If there was an error be sure to propogate it.
+ # This isn't quite the same as what's described by `perldoc -f do`
+ # because there are no rules about what a .t file should return.
+ # Besides all we do after this is diag() the error.
+ my $ex_class = 'Test::Builder::Exception';
+ if( my $e = $@ ){
+ $error = "Couldn't parse $test: $e"
+ unless (
+ # a skip in a subtest will be an object
+ ref($e) ? eval { $e->isa($ex_class) } :
+ # a skip in a BEGIN ("use Test::More skip_all => $message") gets stringified
+ $e =~ /^\Q${ex_class}=HASH(0x\E[[:xdigit:]]+\Q)BEGIN failed--compilation aborted\E/
+ );
+ }
+ elsif( $! ){
+ $error = "Error during $test: $!";
+ }
+ }
+ }
+ # show the error but don't halt everything
+ Test::More::diag($error) if $error;
+ });
+}
+
1;
__END__
diff --git a/t/exception.t b/t/exception.t
new file mode 100644
index 0000000..26a83bb
--- /dev/null
+++ b/t/exception.t
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+aggregate('Test::Aggregate');
+
+SKIP: {
+ skip 'Need Test::More::subtest() for nested tests', 1
+ if !Test::More->can('subtest');
+
+ aggregate('Test::Aggregate::Nested');
+}
+
+done_testing;
+
+sub aggregate {
+ my $mod = shift;
+ eval "require $mod" or die $@;
+
+ # Test::Tester didn't work well with Test::Aggregate
+ # so just override the functions used in the tests
+ my $tb = {};
+ {
+ no strict 'refs';
+ no warnings 'redefine';
+ my $ok = \&Test::More::ok;
+ # call the original ok with a true value so that there is a passing test
+ local *Test::More::ok = sub ($;$) { push @{ $tb->{ok} }, [@_]; $ok->(1, 'shh'); };
+ local *Test::More::diag = sub { push @{ $tb->{diag} }, $_[0] };
+
+ $mod->new({
+ dirs => 'aggtests-exception',
+ })->run;
+ }
+
+ is scalar(grep { /Ensure exceptions are not hidden during aggregate tests/ } @{ $tb->{diag} }), 1,
+ 'Exception displayed via diag()';
+}