Preserving diagnostics when dieing on test failure

[Ovid]

Here's my test:

  #!/usr/bin/perl
 
  use strict; 
  use warnings;
 
  use lib '.';
  use MyTestMore 'no_plan', 'fail';
 
  ok 1;
  ok 1;
  is 2, 3, 'bad';
  ok 1;

Here's my output:

  ok 1
  ok 2
  not ok 3 - bad
  #   Failed test 'bad'
  #   at /System/Library/Perl/5.8.6/Test/More.pm line 329.
  #  got: '2'
  # expected: '3'
  Test failed.  Halting at MyTestMore.pm line 54.
  1..3
  # Looks like you failed 1 test of 3.
  # Looks like your test died just after 3.

So we can preserve diagnostics, but we need help in cleaning up those
damned line numbers.  Hook::LexWrap didn't have the magic I thought it
would.

Below is how I did it.  See the 'import' method.  There's a lot more
work to be done to get fine-grained control, but the line numbers are
the important bit.

Cheers,
Ovid

  package MyTestMore;;
  
  use strict;
  use warnings;
  
  use Hook::LexWrap;
  
  # XXX don't use 'base' as it can override our signal handlers
  use Test::Builder::Module;
  our ( @ISA, @EXPORT );
  
  use Test::More;
  use Test::Differences;
  use Test::Exception;
  
  BEGIN {
  @ISA = qw(Test::Builder::Module);
  @EXPORT = (
  @Test::More::EXPORT,
  @Test::Differences::EXPORT,
  @Test::Exception::EXPORT,
  'explain',
  );
  
  if ( Test::Differences->VERSION <= 0.47 ) {
  
  # XXX There's a bug in Test::Differences 0.47 which attempts
to render
  # an AoH in a cleaner 'table' format.
  # http://rt.cpan.org/Public/Bug/Display.html?id=29732
  no warnings 'redefine';
  *Test::Differences::_isnt_HASH_of_scalars = sub {
  return 1 if ref ne "HASH";
  return scalar grep ref, values %$_;
  };
  }
  }
  
  sub import {
  for my $i (0 .. $#_) {
  if ('fail' eq $_[$i]) {
  splice @_, $i, 1;
  wrap 'Test::Builder::ok', pre => sub {
  $_[0]->{XXX_test_failed} = 0;
},
post => sub {
  $_[0]->{XXX_test_failed} = ![ $_[0]->summary ]->[-1];
};
  wrap 'Test::Builder::diag', post => sub {
  if ( $_[0]->{XXX_test_failed} ) {
  $_[0]->{XXX_test_failed} = 0;
  die "Test failed.  Halting";
  }
  };
  last;
  }
  }
  
  # 'magic' goto to avoid updating the callstack
  goto &Test::Builder::Module::import;
  }
  
  sub explain {
  return unless $ENV{TEST_VERBOSE};
  Test::More::diag(@_);
  }
  
  1;


--
Buy the book  - http://www.oreilly.com/catalog/perlhks/
Perl and CGI  - http://users.easystreet.com/ovid/cgi_course/
Personal blog - http://publius-ovidius.livejournal.com/
Tech blog - http://use.perl.org/~Ovid/journal/

Re: Preserving diagnostics when dieing on test failure

[Michael G Schwern]

Ovid wrote:
> So we can preserve diagnostics, but we need help in cleaning up those
> damned line numbers.  Hook::LexWrap didn't have the magic I thought it
> would.

ok() is now inside a wrapper so you're one level further down then it thinks.
 Just add one to $Level and then take it back off again afterwards.

  wrap 'Test::Builder::ok',
pre => sub {
  $_[0]->{XXX_test_failed} = 0;
  $Test::Builder::Level++;
},
post => sub {
  $Test::Builder::Level--;
  $_[0]->{XXX_test_failed} = ![ $_[0]->summary ]->[-1];
};


> Below is how I did it.  See the 'import' method.  There's a lot more
> work to be done to get fine-grained control, but the line numbers are
> the important bit.

Not everything prints more diagnostics, like ok() itself.

$ perl -wle 'use OurMore "fail", "no_plan";  ok(0);  ok(1);  ok(0);  ok(1)'
not ok 1
#   Failed test at -e line 1.
ok 2
not ok 3
#   Failed test at -e line 1.
ok 4
1..4
# Looks like you failed 2 tests of 4.

But you can probably special case that and fail().

The bigger problem is what happens if a function calls diag() more than once,
like Test::Exception.

$ perl -wle 'use OurMore "no_plan";  throws_ok { die; } qr/foo/;  pass()'
not ok 1 - threw Regexp ((?-xism:foo))
#   Failed test 'threw Regexp ((?-xism:foo))'
#   at -e line 1.
# expecting: Regexp ((?-xism:foo))
# found: Died at -e line 1.
ok 2
1..2
# Looks like you failed 1 test of 2.

$ perl -wle 'use OurMore "fail", "no_plan";  throws_ok { die; } qr/foo/;  
pass()'
not ok 1 - threw Regexp ((?-xism:foo))
#   Failed test 'threw Regexp ((?-xism:foo))'
#   at -e line 1.
# expecting: Regexp ((?-xism:foo))
Test failed.  Halting at OurMore.pm line 55.
1..1
# Looks like you failed 1 test of 1.
# Looks like your test died just after 1.

(Note the lack of "found")


-- 
94. Crucifixes do not ward off officers, and I should not test that.
-- The 213 Things Skippy Is No Longer Allowed To Do In The U.S. Army
   http://skippyslist.com/?page_id=3