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/