File Coverage

blib/lib/Test2/Plugin/SourceDiag.pm

Criterion	Covered	Total	%
statement	92	92	100.0
branch	39	52	75.0
condition	23	35	65.7
subroutine	12	12	100.0
pod	0	4	0.0
total	166	195	85.1

package Test2::Plugin::SourceDiag;
use strict;
use warnings;

our $VERSION = '0.000005';

use Test2::Event::Diag;

use Scalar::Util();

use Test2::API qw{
    test2_add_callback_post_load
    test2_stack
};

my %SEEN;

sub import {
    my $class  = shift;
    my %params = @_;

    $params{show_source} = 1 unless defined $params{show_source};

    test2_add_callback_post_load(
        sub {
            my $hub = test2_stack()->top;
            $hub->filter(\&filter, inherit => 1) if $params{show_source} || $params{inject_name};
            $hub->listen(\&listener, inherit => 1) if $params{show_source} || $params{show_args};
            $hub->add_context_init(\&context_init) if $params{show_args};
        }
    );
}

sub context_init {
    my $ctx = shift;

    package DB;

    my @caller = caller(1);
    my %args   = @DB::args;
    my $level  = $args{level} || 1;

    @caller = caller(1 + $level);

    $ctx->trace->{args} = [grep { !Scalar::Util::blessed($_) || !$_->isa('Test::Builder')} @DB::args];
}

sub filter {
    my ($hub, $event) = @_;
    return $event unless $event->causes_fail;

    my $trace = $event->trace           or return $event;
    my $code  = get_assert_code($trace) or return $event;

    my $name_set = 0;
    if ($event->can('name') && !$event->name && $event->can('set_name')) {
        my $text = join "\n" => @{$code->{source}};
        $text =~ s/^\s*//;
        $name_set = eval { $event->set_name($text); 1 };
    }

    unless ($name_set) {
        my $start = $code->{start};
        my $end   = $code->{end};
        my $len   = length("$end");
        my $text = join "\n" => map { sprintf("% ${len}s: %s", $start++, $_) } @{$code->{source}};
        $event->meta(__PACKAGE__, {})->{code} = $text;
    }

    return $event;
}

sub listener {
    my ($hub, $event) = @_;

    return unless $event->causes_fail;

    my $trace = $event->trace;
    my $meta  = $event->get_meta(__PACKAGE__);
    my $code  = $meta ? $meta->{code} : undef;
    my $args  = $trace ? $trace->{args} : undef;

    return unless $code || $args;

    my $msg = '';

    $msg .= "Failure source code:\n------------\n$code\n------------\n"
        if $code;

    $msg .= "Failure Arguments: (" . join(', ', map { defined($_) ? "'$_'" : 'undef' } @$args) . ")"
        if $args;

    $hub->send(
        Test2::Event::Diag->new(
            trace   => $trace,
            message => $msg,
        )
    );
}

my %CACHE;

sub get_assert_code {
    my ($trace) = @_;

    my $file = $trace->file    or return;
    my $line = $trace->line    or return;
    my $sub  = $trace->subname or return;
    my $short_sub = $sub;
    $short_sub =~ s/^.*:://;
    return if $short_sub eq '__ANON__';

    my %subs = ($sub => 1, $short_sub => 1);

    require PPI::Document;
    my $pd = $CACHE{$file} ||= PPI::Document->new($file);
    $pd->index_locations;

    my $it = $pd->find(sub { !$_[1]->isa('PPI::Token::Whitespace') && $_[1]->logical_line_number == $line }) or return;

    my $found = $it->[0] or return;

    my $thing = $found;
    while ($thing) {
        if (($thing->can('children') && $subs{($thing->children)[0]->content}) || $subs{$thing->content}) {
            $found = $thing;
            last;
        }

        $thing = $thing->parent;
    }

    my @source;

    push @source => split /\r?\n/, $found->content;

    # Add in any indentation we may have cut off.
    my $prefix = $thing->previous_sibling;
    if ($prefix && $prefix->isa('PPI::Token::Whitespace') && $prefix->content ne "\n") {
        my $space = $prefix->content;
        $space =~ s/^.*\n//s;
        $source[0] = $space . $source[0] if length($space);
    }

    my $start = $found->logical_line_number;
    return {
        start  => $start,
        end    => $start + $#source,
        source => \@source,
    };
}

1;

__END__