ユニットテストの自動化で困るのが副作用を起こすコード。例えば、ファイルのI/Oを含む関数は自動テスト化に少し悩む。
# hoge.pl use strict; use warnings; package HOGE; use IO::File; main(@ARGV) if ($0 eq __FILE__); # テストしたい関数 sub main { my (@args) = @_; return 1 unless (@args >= 2); return 2 unless defined( my $io = IO::File->new($args[0], 'w') ); unless ( defined $io->print($args[1]. "\n") ) { $io->close; return 3 }; return 4 unless defined $io->close; return 0; } 1;
この場合、テストドライバから"use lib"でモジュール参照先を変更してIO::Fileを強制的にテストスタブにしてやれば良い。
# テストドライバ use strict; use warnings; use Test::More tests => 3; use lib 'test'; # モジュール読込先を"test/"に変更する require 'hoge.pl'; # テスト対象 use IO::File; # テストスタブ { # test-1 IO::File->init(); my $r = HOGE::main('out.txt', 'aiueo'); my $ok_define = [0, [ "called IO::File::new out.txt w", "called IO::File::print aiueo\n", "called IO::File::close", ]]; my @op = IO::File->get_operations(); is_deeply([$r, \@op], $ok_define, "test-1"); # 評価 } { # test-2 IO::File->init(); IO::File->set_return("IO::File::print", undef); my $r = HOGE::main('out2.txt', 'hoge'); my $ok_define = [3, [ "called IO::File::new out2.txt w", "called IO::File::print hoge\n", "called IO::File::close", ]]; my @op = IO::File->get_operations(); is_deeply([$r, \@op], $ok_define, "test-2"); # 評価 } { # test-3 IO::File->init(); my $r = HOGE::main(); my $ok_define = [1, []]; my @op = IO::File->get_operations(); is_deeply([$r, \@op], $ok_define, "test-3"); # 評価 }
テスト対象からはテストスタブが呼ばれる。
1..3 ok 1 - test-1 ok 2 - test-2 ok 3 - test-3
テストスタブはこんな感じに実装した。
# テストスタブ - test/IO/File.pm use strict; use warnings; package IO::File; use base qw(Exporter); { my (@operations, %rets); sub init { @operations = %rets = (); } sub get_operations { @operations } # 呼び出されたメソッド sub set_return { my ($this, $method, $return) = @_; # メソッドの戻り値 $rets{$method} = $return; } sub new { my ($class, $path, $mode) = @_; my $me = (caller 0)[3]; push @operations, join " ", ('called', $me, $path, $mode); exists $rets{$me} ? $rets{$me} : bless {}, $class; } sub print { my ($this, $text) = @_; my $me = (caller 0)[3]; push @operations, join " ", ('called', $me, $text); exists $rets{$me} ? $rets{$me} : (0==0); } sub close { my ($this) = @_; my $me = (caller 0)[3]; push @operations, join " ", ('called', $me); exists $rets{$me} ? $rets{$me} : (0==0); } } 1;
応急処置なので結局は設計を改善したほうが良い。