Practice of Programming

プログラム とか Linuxとかの話題

Kansai.pm第9回ミーティング

ひさびさに行ってきました。
Mooseとか、Hadoopとか、面白かったですよ。
naoyaさんが、グーグルの人みたいだったw


LTでちょっと喋ってきましたが、
止められなかったので、時間オーバーしていまいた...。
ごめんなさい。喋りながら時間見れない人なので...。
前半、全部削ればよかった。


http://www.rwds.net/wiki?page=Extending+Test%3A%3ABase


資料はだーいぶぐだぐだです。


喋れなかったことで...

evalの前にオブジェクト作っておくフィルター

こんなフィルターを書くと便利。
evalの前で、テストコード内で使うオブジェクトを作っておけば、
わざわざオブジェクト作る手間が省けて便利。

sub evaldt {
    my $code = shift;
    my $d  = Wiz::DateTime->now();
    my $d2 = Wiz::DateTime->now();
    $d->set_epoch(EPOCH);
    $d2->set_epoch(EPOCH + 86400);
    my $d3 = $d->clone;
    $d3 += YEAR * 3 + MONTH * 2 + DAY * -3;

    my $ret = eval $code;
    Carp::croak $@ if $@;
    return $ret;
}

テストクラスのNGのテスト

テストクラスのテストで、OKはいいけど、NGもテストしないといけない。
これが若干めんどくさい。
NGのテストを書く場合、TODOとして、NGのテストをやって、その出力を奪って、
not ok が出てれば、成功みたいなノリでやりました。僕は。


テストのSTDOUT, STDERRのコントロールは、$builder->output と$builder->failure_outputで行えます。

sub _is_test_ng () {
    my ($code, $msg) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    {
        local $TODO = qq{: It's not TODO, but NG test};
        _like_test($code, qr/^not ok/, $msg);
    }
}

sub _like_test () {
    my($code, $regex, $msg) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 2;
    croak "not code: " . ($code || '')  unless ref $code;
    my $data = "";
    my $sh = IO::Scalar->new(\$data);
    my $builder = Test::More->builder;
    my $stdout = $builder->output;
    my $stderr = $builder->failure_output;
    $builder->output($sh);
    $builder->failure_output($sh);
    eval {
        $code->();
    };
    if ($_DIAG_IN_LIKE_TEST) {
        print $data;
    }
    _to_regexp(\$regex);
    $builder->output($stdout);
    $builder->failure_output($stderr);
    my $r;
    {
        local $TODO = qq{: It's not TODO, but NG test};
        $r = _ok( ($data =~ $regex) ? 1: 0, $msg, $regex, $data);
    }
    return $r;
}

sub _ok () {
    my($r, $msg, $got, $expected, $format) = @_;
    $format ||= <<_M_;
          got: %s
     expected: %s
_M_
    my $ret = ok $r, $msg ? $msg : ();
    no warnings "uninitialized";
    diag sprintf $format, $got, $expected unless $ret;
    return $ret;
}