簡易 Test::Base 風テスト

Perl5 のデータ駆動テストの定番 Test::Base は、 Perl5 でプログラムを書く人には必需品です。 ですが、 インストールして使うだけの人に、 必ず Test::Base も入れるように強制できるかというと、 そうもいきません。

とはいえど、 インストールの際にモジュールを利用する環境でテストはおこなうべきなので、 落としどころを考えておかなければなりません。 まず、 モジュール開発中は、 文句なしに実績のある Test::Base を使うべきです。 そして、 テストをすべて通過して、 配布の段階に達したところで、 コア・モジュールの Test::More で済ませるようにテストを書き直す一手間をかけるのはどうかと考えてみました。 ここがポイントですが、 Test::More でもスペックをそのまま使うべきでしょう。 あくまでも run と filter 適用を for ループに書き直すだけにします。

  1. Test::Base を使ったテストで開発をおこなう。
  2. テストの run_is や run_id_deeply を、 run に書き直す。
  3. スペックから blocks 配列に分割する手続きを Test::Base のコードからコピペして作って利用する。
  4. run を blocks 配列への foreach 文に書き直す。
  5. ブロックの項目をハッシュリファレンスのキーアクセスに書き直し、 filter を手動で適用する。
  6. Test::Base を Test::More に切り替える。

次のテストでは、 run を使っているので、 2番めの書き直しは不要です。

use Template qw(render);
use Test::Base;

plan tests => 1 * blocks;
filters {
    'param' => [qw(eval)],
};
run {
    my($test) = @_;
    my $param = $test->param;
    is render($test->tmpl, $param), $test->expected, $test->name;
};

__END__

=== x
--- tmpl
<p>{{x}}</p>
--- param
{'x'=>'foo'}
--- expected
<p>foo</p>

スペックを切り分けてブロックにする手続きを Test::Base からコピーして整理して作ります。

use Template qw(render);
use Test::More;

my $blocks = split_spec(qw[=== ---], do{local $/=undef; scalar <DATA>}); 

plan tests => 1 * @{$blocks};
for my $test (@{$blocks}) {
    my $param = eval $test->{'param'};
    is render($test->{'tmpl'}, $param), $test->{'expected'}, $test->{'name'};
};

# based on Test::Base
sub split_spec {
    my($cd, $dd, $spec) = @_;
    my @hunks = ($spec =~ m/^(\Q${cd}\E.*?(?=^\Q${cd}\E|\z))/msg);
    my $blocks = [];
    for my $hunk (@hunks) {
        $hunk =~ s/\A\Q${cd}\E[ \t]*(.*)\s+// or die;
        my $block = {'name' => $1};
        my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
        my $description = shift @parts;
        while (@parts) {
            my($type, $filters, $value) = splice @parts, 0, 3;
            $value = defined $value ? $value : q();
            $value =~ s/\n+\Z/\n/msx;
            $block->{$type} = $value;
        }
        push @{$blocks}, $block;
    }
    return $blocks;
}

__END__

=== x
--- tmpl
<p>{{x}}</p>
--- param
{'x'=>'foo'}
--- expected
<p>foo</p>