メタデータからテスト件数を取得する
前回はテストファイルやテストデータの数からテストプランを計算するモジュールを紹介しました。今回はその続きとして、
Test::Class
この手のテストモジュールとしては2000年2月にリリースされたTest::Unitが最初期のものになりますが、
xUnit的な手法を活かしつつ、
use strict;
use warnings;
use Test::Class;
Test::Class->runtests;
package MyTest;
use strict;
use warnings;
use base 'Test::Class';
use Test::More;
use DBI;
sub startup : Test(startup) {
my $self = shift;
$self->{dbh} = DBI->connect('dbi:SQLite::memory:');
note "startup";
}
sub setup : Test(setup) {
my $self = shift;
$self->{dbh}->do('create table foo (id integer primary key, text)');
note "setup";
}
sub insert : Test {
my $self = shift;
ok $self->{dbh}->do('insert into foo values(?, ?)', undef, 1, 'my text');
}
sub teardown : Test(teardown) {
my $self = shift;
$self->{dbh}->do('drop table foo');
note "teardown";
}
sub shutdown : Test(shutdown) {
my $self = shift;
$self->{dbh}->disconnect;
note "shutdown";
}細かな使い方についてはTest::ClassのPODをご覧いただくとして、
テストを追加してみる
動作を確認するためにもうひとつ、
sub select : Tests(2) {
my $self = shift;
$self->insert;
my ($text) = $self->{dbh}->selectrow_array('select text from foo where id = ?', undef, 1);
is $text => 'my text';
}筆者の環境ではproveコマンドを使うといささか出力が崩れてしまいましたが、
> perl test.t # startup # setup 1..3 ok 1 - insert # teardown # setup ok 2 - select ok 3 - select # teardown # shutdown
テストを指定した順番で実行させてみる
このようにsetupとteardownをうまく利用して個々のテストを毎回同じ
sub startup : Test(startup) {
my $self = shift;
$self->{dbh} = DBI->connect('dbi:SQLite::memory:');
$self->{dbh}->do('create table foo (id integer primary key, text)');
note "startup";
}
sub test01 : Test {
my $self = shift;
ok $self->{dbh}->do('insert into foo values(?, ?)', undef, 1, 'my text');
}
sub test02 : Test {
my $self = shift;
my ($text) = $self->{dbh}->selectrow_array('select text from foo where id = ?', undef, 1);
is $text => 'my text';
}
sub shutdown : Test(shutdown) {
my $self = shift;
$self->{dbh}->disconnect;
note "shutdown";
}なお、
use strict;
use warnings;
use MyTest;
Test::Class->runtests;Test::Classの仲間たち
Test::Classはダミアン・
また、
Mooseを利用したテストフレームワークはまだそれほど多くはありませんが、
ここでは参考までに先ほどのテストを両者を使って書き換えてみます。
Test::Able
Test::AbleのほうはTest::Classとかなり互換性があるので、
package MyTest;
use Test::Able;
use Test::More;
use DBI;
startup startup => sub {
my $self = shift;
$self->{dbh} = DBI->connect('dbi:SQLite::memory:');
note "startup";
};
setup setup => sub {
my $self = shift;
$self->{dbh}->do('create table foo (id integer primary key, text)');
note "setup";
};
test plan => 1, insert => sub {
my $self = shift;
ok $self->{dbh}->do('insert into foo values(?, ?)', undef, 1, 'my text');
};
test plan => 2, select => sub {
my $self = shift;
$self->insert;
my ($text) = $self->{dbh}->selectrow_array('select text from foo where id = ?', undef, 1);
is $text => 'my text';
};
teardown teardown => sub {
my $self = shift;
$self->{dbh}->do('drop table foo');
note "teardown";
};
shutdown shutdown => sub {
my $self = shift;
$self->{dbh}->disconnect;
note "shutdown";
};
package main;
MyTest->run_tests;Test::Sweet
Test::Sweetのほうは連載第10回で紹介したMooseX::Declareを利用しているため、
Test::SweetはTest::AbleやTest::Classのようにstartup／
package MyTest;
use MooseX::Declare;
role Test::Sweet::Meta::Test::Trait::setup {
around run($suite_class, @args) {
$suite_class->setup;
$self->$orig($suite_class, @args);
$suite_class->teardown;
}
}
class MyTest {
use Test::Sweet;
use DBI;
method BUILD {
$self->{dbh} = DBI->connect('dbi:SQLite::memory:');
note "startup";
};
method setup {
$self->{dbh}->do('create table foo (id integer primary key, text)');
note "setup";
}
method teardown {
$self->{dbh}->do('drop table foo');
note "teardown";
}
method _insert {
$self->{dbh}->do('insert into foo values(?, ?)', undef, 1, 'my text');
}
test insert (setup) {
ok $self->_insert;
}
test select (setup) {
$self->_insert;
my ($text) = $self->{dbh}->selectrow_array('select text from foo where id = ?', undef, 1);
is $text => 'my text';
}
method DEMOLISH {
$self->{dbh}->disconnect;
note "shutdown";
}
}
package main;
MyTest->new->run;サブテスト
ところで、
> perl test_sweet.t
# startup
1..2
# setup
ok 1
# teardown
1..1
ok 1 - insert
# setup
ok 1
# teardown
1..1
ok 2 - select
# shutdown
これはNested TAP
同じテストをTest::Moreのsubtestを使って表現すると、
use strict;
use warnings;
use Test::More 0.94;
use DBI;
my $dbh;
BEGIN {
$dbh = DBI->connect('dbi:SQLite::memory:');
note "startup";
}
subtest 'insert' => sub {
setup();
ok _insert();
teardown();
done_testing;
};
subtest 'select' => sub {
setup();
_insert();
my ($text) = $dbh->selectrow_array('select text from foo where id = ?', undef, 1);
is $text => 'my text';
teardown();
done_testing;
};
sub setup {
$dbh->do('create table foo (id integer primary key, text)');
note "setup";
}
sub teardown {
$dbh->do('drop table foo');
note "teardown";
}
sub _insert {
$dbh->do('insert into foo values(?, ?)', undef, 1, 'my text');
}
done_testing;
END {
$dbh->disconnect;
note "shutdown";
}本稿執筆時点ではサブテストひとつひとつにdone_
テストがないコードはレガシーコード
テストまわりのモジュールについてはほかにもまだ掘り下げておきたいものがありますが、
どんなに新しい技術を使っても、