Perl のテストについて
<2011/04/10 追記>
改訂版を書きました。よろしければそちらをご参照ください。 Perl のテストについて(2011年改訂版1)
0. 前提
0.2 動作確認環境
% uname -a CYGWIN_NT-5.1 mypc 1.5.25(0.156/4/2) 2008-06-12 19:34 i686 Cygwin % perl -v This is perl, v5.10.0 built for cygwin-thread-multi-64int (with 6 registered patches, see perl -V for more detail) Copyright 1987-2007, Larry Wall Perl may be copied only under the terms of either the Artistic License or the GNU General Public License, which may be found in the Perl 5 source kit. Complete documentation for Perl, including FAQ lists, should be found on this system using "man perl" or "perldoc perl". If you have access to the Internet, point your browser at http://www.perl.org/, the Perl Home Page.
Perl 5.8 以上なら問題ないと思います。
DB のテストでは MySQLを使っています。Windows 用バイナリ(MySQL Server 5.0.67)を使用しています。
1. Test::More の使い方
以下は最も単純な例です。
テストスクリプトには、.t という拡張子をつけることが一般的です。また、テストスクリプトは t というディレクトリに入れることが一般的です。
#!/usr/bin/perl #== 1-1.t == use strict; use warnings; use Test::More tests => 4; # テストの数を書く # use Test::More "no_plan"; # テストの数を書くのが面倒な場合は "no_plan" を使う # ok メソッド。真理値をテストする ok( 1 == 1 ); # is メソッド。文字列の比較。診断メッセージが ok よりも多いので、なるべくこちらを使う is( "abc", "ab" . "c"); # isnt メソッド。is の反対。一致しない場合 isnt("abc", "ab" . "d"); # like メソッド。正規表現の比較 like("abcde", qr/^a/);
テストプログラムは perl コマンドでも実行できますし、prove コマンドを使っても構いません。
% perl 1-1.t 1..4 ok 1 ok 2 ok 3 ok 4
% prove 1-1.t 1-1....ok All tests successful. Files=1, Tests=4, 1 wallclock secs ( 0.00 usr 0.03 sys + 0.16 cusr 0.06 csys = 0.25 CPU) Result: PASS
テストが通らない場合、エラーが表示されます
#!/usr/bin/perl # 1-2.t use strict; use warnings; use Test::More tests => 1; is(1, 2); #エラーになるはず
% prove 1-2.t 1-2....1/1 # Failed test at 1-2.t line 8. # got: '1' # expected: '2' # Looks like you failed 1 test of 1. 1-2.... Dubious, test returned 1 (wstat 256, 0x100) Failed 1/1 subtests Test Summary Report ------------------- 1-2 (Wstat: 256 Tests: 1 Failed: 1) Failed test: 1 Non-zero exit status: 1 Files=1, Tests=1, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.15 cusr 0.06 csys = 0.23 CPU) Result: FAIL
2. Test::More のもう少し現実的な例
サブルーチンをテストします。
テストするサブルーチンを含むファイルを testsub.pl とします
#!/usr/bin/perl # == testsub.pl == use strict; use warnings; # 引数の最大値を返す sub max { my $max = undef; for my $value (@_) { if ( !defined $max ) { $max = $value; } if ( defined $max && $max < $value ) { $max = $value; } } return $max; } 1;
testsub.pl には、配列の中から最大値を求める関数 max があります。これをテストします。
#!/usr/bin/perl # == 01-testsub.t == use strict; use warnings; use Test::More tests => 6; require_ok("testsub.pl"); # 下記ファイルを require できるかテストします require "testsub.pl"; # 利用するサブルーチンを含むファイルを require します is( max((1, 2, 3)), 3); is( max((3, 2, 1)), 3); is( max((1, 1)), 1); is( max((-1, -2, -3)), -1); ok( not defined max(undef) );
テストします。
% prove 01-testsub.t 01-testsub....ok All tests successful. Files=1, Tests=6, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.19 cusr 0.05 csys = 0.25 CPU) Result: PASS
テストが通ったので、(とりあえずは)問題がないことが分かります。
3. テストの利点
先ほど実装したサブルーチン max が冗長な書き方なので、これを改善します。
sub max { my $max = undef; for my $value (@_) { $max = $value if ( !defined $max ); $max = $value if ( defined $max && $max < $value ); } return $max; }
テストします。
% prove 01-testsub.t 01-testsub....ok All tests successful. Files=1, Tests=6, 0 wallclock secs ( 0.01 usr 0.01 sys + 0.14 cusr 0.08 csys = 0.25 CPU) Result: PASS
テストがあれば、安心して修正ができます。
さらに、$max = $value の代入が重なっているのが気になるので、
修正します。
sub max { my $max = shift; for my $value (@_) { $max = $value if ( $max < $value ); } return $max; }
% prove 01-testsub.t 01-testsub....ok All tests successful. Files=1, Tests=6, 1 wallclock secs ( 0.03 usr 0.00 sys + 0.15 cusr 0.03 csys = 0.22 CPU) Result: PASS
サブルーチンの実装をよりシンプルにすることができました。
テストがあると、より実装をシンプルにすることができます。
4. バグ対応
max に文字列が渡る場合があるとします。
現行の実装では、文字列が渡ると警告メッセージが出てしまいます。また、("aaa", "bbb", "ccc") を渡すと、"aaa" が帰ってしまいます。
これに対応します。
まず、テストを修正します。
# == 01-testsub.t == # 中略 use Test::More tests => 8; # テストが増えたので 8 # 中略 # 以下を追加 is( max("aaa", 1, 2, 3), 3); ok( not defined max(("aaa", "bbb", "ccc")) );
実行します。
% prove 01-testsub.t 01-testsub....1/8 Argument "aaa" isn't numeric in numeric lt (<) at testsub.pl line 11. Argument "bbb" isn't numeric in numeric lt (<) at testsub.pl line 11. Argument "aaa" isn't numeric in numeric lt (<) at testsub.pl line 11. Argument "ccc" isn't numeric in numeric lt (<) at testsub.pl line 11. # Failed test at 01-testsub.t line 17. # Looks like you failed 1 test of 8. 01-testsub.... Dubious, test returned 1 (wstat 256, 0x100) Failed 1/8 subtests Test Summary Report ------------------- 01-testsub (Wstat: 256 Tests: 8 Failed: 1) Failed test: 8 Non-zero exit status: 1 Files=1, Tests=8, 1 wallclock secs ( 0.00 usr 0.02 sys + 0.17 cusr 0.03 csys = 0.22 CPU) Result: FAIL
警告が出ている上に、テストが失敗したので、これを通るように修正します
# == testsub.pl == sub max { my $max = undef; for my $value (@_) { next if ( defined $value && $value !~ /^[+-]?\d+$/ ); $max = $value if ( !defined $max || $max < $value ); } return $max; }
% prove 01-testsub.t 01-testsub....ok All tests successful. Files=1, Tests=8, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.14 cusr 0.08 csys = 0.23 CPU) Result: PASS
警告も出ず、テストが通ったので、修正完了です。(が、max の実装はやや複雑になってしまいました。個人的には引数のチェックは呼び出し側にやらせるほうが良いのでは、と思います。)
5. クラス(モジュール)のテスト
まず、下記のようなディレクトリを用意します。
% mkdir lib t % ls lib/ t/
lib ディレクトリにモジュールが、t ディレクトリにモジュールのテストが入ります。
まず、下記のような lib ディレクトリに Food クラス(Food.pm)があるとします。フィールド price とメソッド price_with_tax(税込みの金額)を持つだけの単純なクラスです。
#!/usr/bin/perl # lib/Food.pm use strict; use warnings; package Food; sub new { my $class = shift; my $self = { price => shift }; bless $self, $class; } sub price { return shift->{price}; } sub price_with_tax { return shift->price() * 1.05; } 1;
このモジュールをテストします。 t ディレクトリに、下記のような 01_price_with_tax.t を作成します
#!/usr/bin/perl # t/01_price_with_tax.t use strict; use warnings; use lib qw( ./lib ); use Test::More "no_plan"; use_ok("Food"); use Food; my $tested = Food->new(100); is(105, $tested->price_with_tax());
prove コマンドでテストします。
% prove t/01_price_with_tax....ok All tests successful. Files=1, Tests=2, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.14 cusr 0.06 csys = 0.22 CPU) Result: PASS
6. Test::Class
Test::Class を使うと、xUnit 風の記述が可能です。なお、Test::Class は cpan モジュールなので、別途インストールが必要です。
先ほどと同じ例を Test::Class を使って書いてみます。
t ディレクトリに下記のような、02_price_with_tax2.t を作成します。
#!/usr/bin/perl # t/02_price_with_tax2.t use strict; use warnings; use lib qw( ./lib ); PriceTestWithTax->runtests; # テストクラス名->runtests でテストを実行 package PriceTestWithTax; # テストするパッケージ名(テストクラス名を定義する必要がある) use base qw(Test::Class); # Test::Class を継承する use Test::More "no_plan"; use_ok("Food"); use Food; my $tested; sub setup : Test(setup) { # 初期化。テスト開始前毎に呼ばれる $tested = Food->new(100); } sub tax_test : Test(1) { # テスト数を記載。no_plan 風の Tests という書き方も可能 is(105, $tested->price_with_tax()); } sub teardown : Test(teardown) { # 後始末。テスト終了毎に呼ばれる $tested = undef; } 1;
% prove t/02_price_with_tax2.t t/02_price_with_tax2....ok All tests successful. Files=1, Tests=2, 0 wallclock secs ( 0.00 usr 0.02 sys + 0.33 cusr 0.09 csys = 0.43 CPU) Result: PASS
テストコードの量が増えた場合や、初期化処理が必要な場合は Test::Class を使うほうが良いと思います。(この例くらいの規模だと、逆にコードが増えてしまいますが)
7. ストアドプロシージャのテスト(MySQL)
7.1 DB の準備
まず、下記のような Books テーブルを用意します。
(私は MySQL Administrator で作成してしまいました)
mysql> show fields from books; +--------+------------------+------+-----+---------+----------------+ | Field | Type | Null | Key | Default | Extra | +--------+------------------+------+-----+---------+----------------+ | id | int(10) unsigned | NO | PRI | NULL | auto_increment | | name | text | NO | | NULL | | | price | int(10) unsigned | YES | | NULL | | | author | text | NO | | NULL | | +--------+------------------+------+-----+---------+----------------+
ここにはたとえば下記のようなデータが入ります
+----+---------------------------------------------------------------+-------+---------------------------------+ | id | name | price | author | +----+---------------------------------------------------------------+-------+---------------------------------+ | 1 | 続・初めてのPerl -Perlオブジェクト、リファレンス、モジュール | 2900 | Randal L. Schwartz, Tom Phoenix | +----+---------------------------------------------------------------+-------+---------------------------------+
7.2 ストアドプロシージャの準備
このテーブルを使って、「書籍の ID を渡すと、Perl 関連書籍なら非0, そうでなければ0」を返すプロシージャ
is_perl_book を作ります。
CREATE DEFINER=`root`@`localhost` PROCEDURE `is_perl_book`(IN id_in INTEGER, OUT is_perl INTEGER) BEGIN select count(id) into is_perl from books where id=id_in and name like '%perl%'; END
確認のために実行します。(データは先ほどの1件だけが入った状態です)
mysql> call is_perl_book(1, @a); Query OK, 0 rows affected (0.00 sec) mysql> select @a; +------+ | @a | +------+ | 1 | +------+ 1 row in set (0.00 sec) mysql> call is_perl_book(2, @a); Query OK, 0 rows affected (0.00 sec) mysql> select @a; +------+ | @a | +------+ | 0 | +------+ 1 row in set (0.00 sec)
まずは動作確認ができたので、テストに移ります。
7.3 ストアドプロシージャをテストする
今までのディレクトリとは別のディレクトリに、lib と t を作成します。
% mkdir lib t % ls lib/ t/
まずはストアドプロシージャの単体でテストしてみます。01-is_perl_book.t を作成します
#!/usr/bin/perl # t/01-is_perl_book.t use strict; use warnings; use lib qw( ./lib ); IsPerlBookTest->runtests; package IsPerlBookTest; use base qw(Test::Class); use Test::More; use DBI; my $hDb; sub startup : Test(startup) { $hDb = DBI->connect('dbi:mysql:database=user_db:127.0.0.1', 'root', 'toppan', {RaiseError => 1, PrintError=> 0, AutoCommit => 1}); $hDb->do("truncate table books"); # テーブルをクリア $hDb->do("insert into books (id, name, price, author) values (1, '続・初めてのPerl -Perlオブジェクト、リファレンス、モジュール', 2900, 'Randal L. Schwartz, Tom Phoenix')"); # データ1件目 $hDb->do("insert into books (id, name, price, author) values (2, 'テスト駆動開発入門', 3000, 'ケント・ベック')"); # データ2件目 $hDb->disconnect(); } sub setup : Test(setup) { $hDb = DBI->connect('dbi:mysql:database=user_db:127.0.0.1', 'root', 'toppan', {RaiseError => 1, PrintError=> 0, AutoCommit => 1}); } sub teardown : Test(teardown) { $hDb->disconnect(); } sub is_perl_book_test : Test(1) { # Perl の本なので真 $hDb->do('call is_perl_book(1, @rtnVal)'); my $iVal = $hDb->selectrow_array('SELECT @rtnVal'); ok($iVal); } sub is_not_perl_book_test : Test(1) { # Perl の本ではないので偽 $hDb->do('call is_perl_book(2, @rtnVal)'); my $iVal = $hDb->selectrow_array('SELECT @rtnVal'); is($iVal, 0); } sub no_exist_id_test : Test(1) { # ID が存在しないので偽 $hDb->do('call is_perl_book(-1, @rtnVal)'); my $iVal = $hDb->selectrow_array('SELECT @rtnVal'); is($iVal, 0); } 1;
実行してみます
% prove t/01-is_perl_book.t t/01-is_perl_book....ok All tests successful. Files=1, Tests=3, 1 wallclock secs ( 0.03 usr 0.00 sys + 0.42 cusr 0.09 csys = 0.55 CPU) Result: PASS
テストは無事通過しました。
7.4 データを取得するクラスでテストする
ストアドプロシージャを直接テストで投げず、利用するモジュールから投げる場合です。
Books モジュール(Books.pm)を作り、find_perl_books(Perl の本の一覧を返す)を実装します。
# 効率の悪い実装ですが...
なお、使うデータは先程と同じです。
#!/usr/bin/perl # == lib/Books.pm == use strict; use warnings; package Books; use DBI; sub new { my $class = shift; my $self = { connection_string => shift, user => shift, pass => shift, }; bless $self, $class; } sub find_perl_books { my $self = shift; my @result; my $hDb = DBI->connect($self->{connection_string}, $self->{user}, $self->{pass}, {RaiseError => 1, PrintError=> 0, AutoCommit => 1}); for my $book ( $self->_all_books($hDb) ) { $hDb->do("call is_perl_book(" . $book->{id} . ", \@rtnVal)"); push @result, $book if ( $hDb->selectrow_array('SELECT @rtnVal') ) ; } $hDb->disconnect(); return @result; } sub _all_books { # すべての本を取得 my $self = shift; my ($hDb) = @_; my @books; my $hSt = $hDb->prepare("select id, name, price, author from books"); $hSt->execute(); while(my $book_href = $hSt->fetchrow_hashref()) { push @books, Book->new($book_href->{id}, $book_href->{name}, $book_href->{price}, $book_href->{author}); } $hSt->finish; return @books; } package Book; sub new { my $class = shift; my $self = { id => shift, name => shift, price => shift, author => shift, }; bless $self, $class; } sub id { return shift->{id}; } sub name { return shift->{name}; } sub price { return shift->{price}; } sub author { return shift->{author}; } 1;
では、これをテストします。
t/02-books.t を作成します。
#!/usr/bin/perl # t/02-books.t use strict; use warnings; use lib qw( ./lib ); BooksTest->runtests; package BooksTest; use base qw(Test::Class); use Test::More; use DBI; use Books; sub startup : Test(startup) { my $hDb = DBI->connect('dbi:mysql:database=user_db:127.0.0.1', 'root', 'toppan', {RaiseError => 1, PrintError=> 0, AutoCommit => 1}); $hDb->do("truncate table books"); # テーブルをクリア $hDb->do("insert into books (id, name, price, author) values (1, '続・初めてのPerl -Perlオブジェクト、リファレンス、モジュール', 2900, 'Randal L. Schwartz, Tom Phoenix')"); # データ1件目 $hDb->do("insert into books (id, name, price, author) values (2, 'テスト駆動開発入門', 3000, 'ケント・ベック')"); # データ2件目 $hDb->disconnect(); } sub find_perl_books_test : Test(5) { my $books = Books->new('dbi:mysql:database=user_db:127.0.0.1', 'root', 'toppan'); my @perl_books = $books->find_perl_books(); is(@perl_books, 1); is($perl_books[0]->id, 1); is($perl_books[0]->name, "続・初めてのPerl -Perlオブジェクト、リファレンス、モジュール"); is($perl_books[0]->price, 2900); is($perl_books[0]->author, "Randal L. Schwartz, Tom Phoenix"); }
テストを実行してみます。
% prove t/02-books.t t/02-books....ok All tests successful. Files=1, Tests=5, 1 wallclock secs ( 0.01 usr 0.00 sys + 0.41 cusr 0.09 csys = 0.51 CPU) Result: PASS
PASS しました。
