File Coverage

blib/lib/Test/More/Diagnostic.pm

Criterion	Covered	Total	%
statement	27	32	84.3
branch	3	4	75.0
condition	2	8	25.0
subroutine	8	10	80.0
pod	2	2	100.0
total	42	56	75.0

package Test::More::Diagnostic;

use warnings;
use strict;
use Carp;
use TAP::Parser::YAMLish::Writer;

our $VERSION = '0.2';
our @ISA     = qw( Test::Builder );

use constant KNOWN_TAP_VERSION => 13;

# Bless builder into our package.
bless Test::More->builder, __PACKAGE__;

sub _should_yaml {
    my $tap_version = $ENV{TAP_VERSION};
    return defined $tap_version && $tap_version >= KNOWN_TAP_VERSION;
}

# Fix up caller
sub caller {
    my ( $self, $height ) = @_;
    $height ||= 0;
    return $self->SUPER::caller( $height + 2 );
}

{
    my $did_version = 0;

    sub _print {
        my $self = shift;
        unless ( $did_version ) {
            $self->SUPER::_print( 'TAP version ' . KNOWN_TAP_VERSION );
            $did_version++;
        }
        return $self->SUPER::_print( @_ );
    }
}

# Add YAML to OK
sub ok {
    my ( $self, $test, $name ) = @_;
    my $ok = $self->SUPER::ok( $test, $name );
    if ( !$ok && _should_yaml() ) {
        my ( $pack, $file, $line ) = $self->caller( -1 );
        TAP::Parser::YAMLish::Writer->new->write(
            {
                file => $file,
                line => $line,
            },
            sub {
                $self->_print( '  ' . $_[0] );
            }
        );
    }
    return $ok;
}

1;
__END__