Test::More::unlike でマッチしちゃった場合の位置を得る

Test::More の unlike で長大なテキストをテストして fail したとき = マッチした場合、テキスト全体と unlike に渡した qr/expected/ が出力されるが、そこからマッチした位置を探すのが面倒くさいので、以下のように位置を表示するようにしてみた。

use strict;
use warnings;
use Test::More;

my $txt = <<"_TXT_";
01234567890
abcdefghijklmn
opqrstuvwxyz
_TXT_

my $regex = qr/jk/s;

unlike $txt, $regex or do {
    my ($line, $offset) = _matched_position(\$txt, $regex);
    note( "\t    matched at line: $line, offset: $offset");
};

done_testing;

sub _matched_position {
    my ($string_ref, $regex) = @_;

    my $match = (split /$regex/, $$string_ref)[0];
    $match =~ s/\x0D\x0A/\n/g;
    $match =~ tr/\r/\n/;

    my $line_count = ($match =~ s/\n/\n/g);
    $line_count++;

    my $offset = length( (split /\n/, $match)[-1] ) + 1;

    return($line_count, $offset);
}

以下のように、matched at の情報を付与します。

not ok 1
#   Failed test at ./index.pl line 14.
#                   '01234567890
# abcdefghijklmn
# opqrstuvwxyz
# '
#           matches '(?s-xim:jk)'
#           matched at line: 2, offset: 10
1..1
# Looks like you failed 1 test of 1.

最初にマッチした位置しか出さないっていう問題があったり他にも考慮すべきことはいろいろありそうですがまあ取り急ぎ。

テストが通ってるときは気にならない問題だし、さっと直して忘れてしまえばどうでもよかったりしますが、けっこうあると便利かなあと思ったりしました。

Test::More::Unlike にまとめて CPAN リリースしました。

Test::More といっしょに use するだけで、unlike に line, offset 情報を追加します。