Perlで抽象クラス的なものをテストしたい場合どうするか
例えば、以下のような抽象クラス?的なモジュールがあるとしねえ。
package AbstractClass; sub call { my ($self, @args) = @_; # なんか色々前処理とかする $self->do_something($params); } # ここから後にdo_somethingの実装はない (いわゆる抽象メソッド的なアレ)
plugin的な仕組みを用意したいとき、こんなコードが出てくると思います。「この抽象クラスを継承したクラスで、do_somethingを実装する」ということにして、その中身はクラスごとに違う、と。使う側は常にcallを呼び出して、共通する前処理をcallの中でやってもらって後、サブクラスのdo_somethingに処理が移る。
で、このcallメソッドのtestをしたいんだけど、このAbstractClassをそのままnewしてcallを呼んじゃうと、当然ながらdo_somethingの実装がないのでずっこけちゃってtestにならんわけです。
AbstractClassを継承するクラスも書いてしまって、ソイツを通じてcallのtestを書いてもいいんだけど、人情としてはやっぱりAbstractClass単品でtestしたい。できたら、AbstractClassがちゃんと動くことを確認してのち具象クラスのテストに移りたいなあ、と。継承ツリー順というか。
で、こういう事態になった場合、t/libとか掘ってその下にAbstractClassを継承するテスト専用モジュールを作るのが割とクリーンな解かなぁと思うんだけど、それもめんどくさい。適当なサブクラスを一つ増やすたびにファイルを一つ増やさなきゃいけないなんてだるすぎる。
なので、t/lib以下に次のようなものをでっち上げた。結局ファイル一個増えんじゃねーか、というツッコミはなしよ。これは一般化の試みなのだから。
package Driver; use strict; use warnings; use Class::Load qw/load_class/; our @ISA = (); sub create { my ($class, $parent, $subs, $opts) = @_; load_class($parent); push @ISA, $parent; for my $subname (keys %$subs) { no strict 'refs'; no warnings 'redefine'; *{$subname} = $subs->{$subname}; } return $class->SUPER::new($opts); } sub DESTROY { @ISA = (); } 1;
このモジュールを読み込んだ上で、以下のようにしてあげるとあらふしぎ!
my $anon = Driver->create("AbstractClass", +{ do_something => sub { print "hmmmmm"; } });
AbstractClassを継承してdo_somethingを実装した適当なクラスを実行時に気軽に定義&インスタンス化できます。やったねたえちゃん!クラスが増えるよ!@ISAとかを適当にいじってるのでこのままだとデンジャラーな感じがしますが、とりあえずはこれでいいのです。
CPANモジュールの海は広いので、こういうことをしてくれるモジュールが既にあって、僕が知らないだけなのかもしれん。こういう時は皆さんどうしてるのかしら?
…と思っていたところ、似たようなことがTest::Mock::Guardで出来ることに気がついた。
Test::Mock::Guardについてはこちら -> http://d.hatena.ne.jp/ZIGOROu/20110308/1299605305
use Test::Mock::Guard qw/mock_guard/; my $guard = mock_guard("AbstractClass", +{ do_something => sub { print "hmmmmm"; } }); my $anon = AbstractClass->new;
こんな感じで。
AbstractClassに直接do_somethingを生やすことになるので厳密にはやりたいことと違う && 微妙にひと手間増えるんだけど、特に問題ない気がする。