2009年 12月 15日

テストで result と exptected が違うときに色つき diff

結構長い文字列を比較させるとどこが違っているのかよくわからん…… ということがあるので、クソコードを書いて結果を読みやすくしました。Test::Builder::_is_diag を書きかえています

use Test::More;
use Algorithm::Diff;
use Term::ANSIColor;

sub colordiff {
    my ($a, $b) = @_;
    my $ret = "";

    my $diff = Algorithm::Diff->new([ split /\n/, $a ], [ split /\n/, $b ]);
    $diff->Base(1);
    while ($diff->Next) {
        if ($diff->Same) {
            $ret .= "  " . $_ . "\n" for $diff->Items(1);
        }
        elsif (!$diff->Items(2)) {
            $ret .= colored("- " . $_, 'red').   "\n" for $diff->Items(1);
        }
        elsif (!$diff->Items(1)) {
            $ret .= colored("+ " . $_, 'green'). "\n" for $diff->Items(2);
        }
        else {
            my $lineDiff = Algorithm::Diff->new(
                [ split //, "* " . join("\n* ", $diff->Items(1)) . "\n" ],
                [ split //, "* " . join("\n* ", $diff->Items(2)) . "\n" ]
            );
            $lineDiff->Base(1);

            while ($lineDiff->Next) {
                if ($lineDiff->Same) {
                    $ret .= $_ for $lineDiff->Items(1);
                } elsif (!$lineDiff->Items(2)) {
                    $ret .= colored($_, 'red')   for $lineDiff->Items(1);
                } elsif (!$lineDiff->Items(1)) {
                    $ret .= colored($_, 'green') for $lineDiff->Items(2);
                } else {
                    $ret .= colored($_, 'red')   for $lineDiff->Items(1);
                    $ret .= colored($_, 'green') for $lineDiff->Items(2);
                }
            }
        }
    }
    $ret;
}

{
    *Test::Builder::_is_diag  = sub {
        my ($self, $got, $type, $expect) = @_;

        $self->_diag_fmt( $type, $_ ) for \$got, \$expect;
        my $diff = colordiff($got, $expect);

        no strict;
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        return $self->diag(<<"DIAGNOSTIC");
         got: $got
    expected: $expect
$diff
DIAGNOSTIC
    };
}

あと、printable ではない文字を、そのままテスト結果に吐かれても困るので

{
    no warnings 'redefine';
    *Test::Builder::_diag_fmt = sub {
        my ($self, $type, $val) = @_;
        if ( defined $$val ) {
            if( $type eq 'eq' or $type eq 'ne' ) {
                $$val = dumper($$val);
                $$val = "'$$val'";
            }
            else {
                $self->_unoverload_num($val);
            }
        } else {
            $$val = 'undef';
        }
    };
}

sub dumper ($) {
    my ($str) = @_;
    $str =~ s{([^\x0a\x20-\x7e\x{3040}-\x{309F}\x{30A0}-\x{30FF}])}{
        sprintf('\\x%02x', ord $1);
    }eg;
    $str;
}

とかやっています。見えない文字があるとかは切実に困るので割と便利です