Perl日記

日々の知ったことのメモなどです。Perlは最近やってないです。

Test::Specその2

元ネタ「RSpec の入門とその一歩先へ、第2イテレーション - t-wadaの日記」「RSpec の入門とその一歩先へ、第3イテレーション - t-wadaの日記
第2、第3イテレーションも見ておく

  • describeに説明を追加
  • describeの引数は2つが限界なので、文字列にして説明してあげる必要あり

lib/MessageFilter.pm

 use MessageFilter;
 use Test::Spec;
 
-describe MessageFilter => sub {
+describe 'MessageFilter with argument "foo"' => sub {
   my $filter;
   before sub {
     $filter = MessageFilter->new('foo');
   };
 
   it 'should detect message with NG word' => sub {
     ok($filter->is_detect('hello from foo'));
   };
   it 'should not detect message without NG word' => sub {
     ok(!$filter->is_detect('hello, world'));
   };
 };
 
 runtests unless caller;

コンストラクタ引数改造のテスト追加

t/message_filter_spec.t

 use MessageFilter;
 use Test::Spec;
 
 describe 'MessageFilter with argument "foo"' => sub {
   my $filter;
   before sub {
     $filter = MessageFilter->new('foo');
   };
 
   it 'should detect message with NG word' => sub {
     ok($filter->is_detect('hello from foo'));
   };
   it 'should not detect message without NG word' => sub {
     ok(!$filter->is_detect('hello, world'));
   };
 };
 
+describe 'MessageFilter with argument "foo","bar"' => sub {
+  my $filter;
+  before sub {
+    $filter = MessageFilter->new('foo', 'bar');
+  };
+
+  it 'should detect message with NG word' => sub {
+    ok($filter->is_detect('hello from bar'));
+  };
+};
+
 runtests unless caller;
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
not ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
#   Failed test 'MessageFilter with argument "foo","bar" should detect message with NG word'
#   at t/message_filter_spec.t line 25.
1..3
# Looks like you failed 1 test of 3.
  • 失敗した失敗した失敗した

@_はすでに可変引数(というか配列)なのでそれを利用して実装

lib/MessageFilter.pm

 package MessageFilter {
   use strict;
   use warnings;
 
   sub new {
-    my ($class, $word) = @_;
-    bless { word => $word }, $class;
+    my ($class, @words) = @_;
+    bless { words => \@words }, $class;
   }
 
   sub is_detect {
     my ($self, $word) = @_;
-    return index($word, $self->{word}) >= 0;
+    for my $filter_word (@{$self->{words}}) {
+      return 1 if index($word, $filter_word) >= 0;
+    }
+    return;
   }
 }
 
 1;
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
1..3

過去のテストをコピペ

t/message_filter_spec.t

 use MessageFilter;
 use Test::Spec;
 
 describe 'MessageFilter with argument "foo"' => sub {
   my $filter;
   before sub {
     $filter = MessageFilter->new('foo');
   };
 
   it 'should detect message with NG word' => sub {
     ok($filter->is_detect('hello from foo'));
   };
   it 'should not detect message without NG word' => sub {
     ok(!$filter->is_detect('hello, world'));
   };
 };
 
 describe 'MessageFilter with argument "foo","bar"' => sub {
   my $filter;
   before sub {
     $filter = MessageFilter->new('foo', 'bar');
   };
 
   it 'should detect message with NG word' => sub {
     ok($filter->is_detect('hello from bar'));
   };
+  it 'should detect message with NG word' => sub {
+    ok($filter->is_detect('hello from foo'));
+  };
+  it 'should not detect message without NG word' => sub {
+    ok(!$filter->is_detect('hello, world'));
+  };
 };
 
 runtests unless caller;
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..5
  • 動いてる

shared_examples_forを使ってテストの重複を排除する

t/message_filter_spec.t

 use MessageFilter;
 use Test::Spec;
 
+my $filter;
+shared_examples_for 'MessageFilter with argument "foo"' => sub {
+  it 'should detect message with NG word' => sub {
+    ok($filter->is_detect('hello from foo'));
+  };
+  it 'should not detect message without NG word' => sub {
+    ok(!$filter->is_detect('hello, world'));
+  };
+};
 
 describe 'MessageFilter with argument "foo"' => sub {
-  my $filter;
   before sub {
     $filter = MessageFilter->new('foo');
   };

-  it 'should detect message with NG word' => sub {
-    ok($filter->is_detect('hello from foo'));
-  };
-  it 'should not detect message without NG word' => sub {
-    ok(!$filter->is_detect('hello, world'));
-  };
+  it_should_behave_like 'MessageFilter with argument "foo"';
 };

 describe 'MessageFilter with argument "foo","bar"' => sub {
-  my $filter;
   before sub {
     $filter = MessageFilter->new('foo', 'bar');
   };
 
   it 'should detect message with NG word' => sub {
     ok($filter->is_detect('hello from bar'));
   };
-  it 'should detect message with NG word' => sub {
-    ok($filter->is_detect('hello from foo'));
-  };
-  it 'should not detect message without NG word' => sub {
-    ok(!$filter->is_detect('hello, world'));
-  };
+  it_should_behave_like 'MessageFilter with argument "foo"';
 };
 
 runtests unless caller;
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..5
  • OK

describeをネストする

t/message_filter_spec.t

use MessageFilter;
use Test::Spec;

describe MessageFilter => sub {
  my $filter;
  shared_examples_for 'MessageFilter with argument "foo"' => sub {
    it 'should detect message with NG word' => sub {
      ok($filter->is_detect('hello from foo'));
    };
    it 'should not detect message without NG word' => sub {
      ok(!$filter->is_detect('hello, world'));
    };
  };

  describe 'with argument "foo"' => sub {
    before sub {
      $filter = MessageFilter->new('foo');
    };

    it_should_behave_like 'MessageFilter with argument "foo"';
  };

  describe 'with argument "foo","bar"' => sub {
    before sub {
      $filter = MessageFilter->new('foo', 'bar');
    };

    it 'should detect message with NG word' => sub {
      ok($filter->is_detect('hello from bar'));
    };
    it_should_behave_like 'MessageFilter with argument "foo"';
  };
};

runtests unless caller;
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..5

状況を記すにはdescribeよりcontext

# make context() an alias for describe()
sub context(@);
BEGIN { *context = \&describe }
  • 引数の状況を表すのでcontextを使う
diff --git a/t/message_filter_spec.t b/t/message_filter_spec.t
index 53f7701..198bf32 100644
--- a/t/message_filter_spec.t
+++ b/t/message_filter_spec.t
@@ -12,7 +12,7 @@ describe MessageFilter => sub {
     };
   };
 
-  describe 'with argument "foo"' => sub {
+  context 'with argument "foo"' => sub {
     before sub {
       $filter = MessageFilter->new('foo');
     };
@@ -20,7 +20,7 @@ describe MessageFilter => sub {
     it_should_behave_like 'MessageFilter with argument "foo"';
   };
 
-  describe 'with argument "foo","bar"' => sub {
+  context 'with argument "foo","bar"' => sub {
     before sub {
       $filter = MessageFilter->new('foo', 'bar');
     };
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..5
  • 実行結果も変わらず

実装のリファクタリング

  • そうだ。grepを使おう。
  • 本当はList::Util::first使うのが最適解だろうな、grepだと全部回っちゃうし
diff --git a/lib/MessageFilter.pm b/lib/MessageFilter.pm
index cb9ed28..acd041c 100644
--- a/lib/MessageFilter.pm
+++ b/lib/MessageFilter.pm
@@ -9,10 +9,7 @@ package MessageFilter {
 
   sub is_detect {
     my ($self, $word) = @_;
-    for my $filter_word (@{$self->{words}}) {
-      return 1 if index($word, $filter_word) >= 0;
-    }
-    return;
+    return grep index($word, $_) >= 0, @{$self->{words}};
   }
 }
  • 実行してみる
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..5

アクセサのテスト

  • どんなNGワードがいま設定されいてるか見えるようにする
  • 素朴に実装するよ!
diff --git a/t/message_filter_spec.t b/t/message_filter_spec.t
index 198bf32..3bc92f3 100644
--- a/t/message_filter_spec.t
+++ b/t/message_filter_spec.t
@@ -18,6 +18,9 @@ describe MessageFilter => sub {
     };
 
     it_should_behave_like 'MessageFilter with argument "foo"';
+    it 'ng_words should not be empty' => sub {
+      ok($filter->ng_words);
+    };
   };
 
   context 'with argument "foo","bar"' => sub {
  • 死ぬことを確認する
$ perl -Ilib t/message_filter_spec.t 
not ok 1 - MessageFilter with argument "foo" ng_words should not be empty
#   Failed test 'MessageFilter with argument "foo" ng_words should not be empty' by dying:
#     Can't locate object method "ng_words" via package "MessageFilter"
#     at t/message_filter_spec.t line 22.
ok 2 - MessageFilter with argument "foo" should detect message with NG word
ok 3 - MessageFilter with argument "foo" should not detect message without NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 6 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..6
# Looks like you failed 1 test of 6.
  • あれ、順番はRSpecと違って、it_should_behave_likeから動いてくれてないのか…
  • 実装してみる
diff --git a/lib/MessageFilter.pm b/lib/MessageFilter.pm
index acd041c..b4d9fb3 100644
--- a/lib/MessageFilter.pm
+++ b/lib/MessageFilter.pm
@@ -3,13 +3,18 @@ package MessageFilter {
   use warnings;
 
   sub new {
-    my ($class, @words) = @_;
-    bless { words => \@words }, $class;
+    my ($class, @ng_words) = @_;
+    bless { ng_words => \@ng_words }, $class;
+  }
+
+  sub ng_words {
+    my $self = shift;
+    return @{$self->{ng_words}};
   }
 
   sub is_detect {
     my ($self, $word) = @_;
-    return grep index($word, $_) >= 0, @{$self->{words}};
+    return grep index($word, $_) >= 0, $self->ng_words;
   }
 }
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" ng_words should not be empty
ok 2 - MessageFilter with argument "foo" should detect message with NG word
ok 3 - MessageFilter with argument "foo" should not detect message without NG word
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 6 - MessageFilter with argument "foo","bar" should not detect message without NG word
1..6

shared_examples_forに移動してみる

diff --git a/t/message_filter_spec.t b/t/message_filter_spec.t
index 3bc92f3..94b1d6f 100644
--- a/t/message_filter_spec.t
+++ b/t/message_filter_spec.t
@@ -10,6 +10,9 @@ describe MessageFilter => sub {
     it 'should not detect message without NG word' => sub {
       ok(!$filter->is_detect('hello, world'));
     };
+    it 'ng_words should not be empty' => sub {
+      ok($filter->ng_words);
+    };
   };
 
   context 'with argument "foo"' => sub {
@@ -18,9 +21,6 @@ describe MessageFilter => sub {
     };
 
     it_should_behave_like 'MessageFilter with argument "foo"';
-    it 'ng_words should not be empty' => sub {
-      ok($filter->ng_words);
-    };
   };
 
   context 'with argument "foo","bar"' => sub {
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" should detect message with NG word
ok 2 - MessageFilter with argument "foo" should not detect message without NG word
ok 3 - MessageFilter with argument "foo" ng_words should not be empty
ok 4 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 5 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 6 - MessageFilter with argument "foo","bar" should not detect message without NG word
ok 7 - MessageFilter with argument "foo","bar" ng_words should not be empty
1..7

個数を調べる

diff --git a/t/message_filter_spec.t b/t/message_filter_spec.t
index 94b1d6f..448b2e5 100644
--- a/t/message_filter_spec.t
+++ b/t/message_filter_spec.t
@@ -21,6 +21,9 @@ describe MessageFilter => sub {
     };
 
     it_should_behave_like 'MessageFilter with argument "foo"';
+    it 'ng_words size is 1' => sub {
+      cmp_ok(scalar($filter->ng_words), '==', 1);
+    };
   };
 
   context 'with argument "foo","bar"' => sub {
@@ -32,6 +35,9 @@ describe MessageFilter => sub {
       ok($filter->is_detect('hello from bar'));
     };
     it_should_behave_like 'MessageFilter with argument "foo"';
+    it 'ng_words size is 2' => sub {
+      cmp_ok(scalar($filter->ng_words), '==', 2);
+    };
   };
 };
$ perl -Ilib t/message_filter_spec.t 
ok 1 - MessageFilter with argument "foo" ng_words size is 1
ok 2 - MessageFilter with argument "foo" should detect message with NG word
ok 3 - MessageFilter with argument "foo" should not detect message without NG word
ok 4 - MessageFilter with argument "foo" ng_words should not be empty
ok 5 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 6 - MessageFilter with argument "foo","bar" ng_words size is 2
ok 7 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 8 - MessageFilter with argument "foo","bar" should not detect message without NG word
ok 9 - MessageFilter with argument "foo","bar" ng_words should not be empty
1..9
  • OK

proveで実行してみる

$ prove -lv t/*.t 
t/message_filter_spec.t .. 
ok 1 - MessageFilter with argument "foo" ng_words size is 1
ok 2 - MessageFilter with argument "foo" should detect message with NG word
ok 3 - MessageFilter with argument "foo" should not detect message without NG word
ok 4 - MessageFilter with argument "foo" ng_words should not be empty
ok 5 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 6 - MessageFilter with argument "foo","bar" ng_words size is 2
ok 7 - MessageFilter with argument "foo","bar" should detect message with NG word
ok 8 - MessageFilter with argument "foo","bar" should not detect message without NG word
ok 9 - MessageFilter with argument "foo","bar" ng_words should not be empty
1..9
ok
All tests successful.
Files=1, Tests=9,  0 wallclock secs ( 0.02 usr  0.00 sys +  0.06 cusr  0.00 csys =  0.08 CPU)
Result: PASS

ここまでの感想

  • やっぱりRSpecのマッチャは強いなと思った
    • 勝手にテストのメッセージになる
  • とは言うもののシンプルなテストならPerlのTest::Specでも普通にありだなと思った
  • Test::Specにできることを次にやってみる