初めてのテストケース

Test::Simple、アラヤダほんとにシンプル。

パッケージのコード

      1 #!/usr/local/bin/perl
      2
      3 # Class Structを使わないパターン
      4
      5 package DataContainer;
      6 use strict;
      7 use warnings;
      8 use Data::Dumper;
      9
     10 sub new {
     11     my $class = shift;
     12     return bless { _container => {} }, $class;
     13 }
     14
     15 sub set {
     16     my $self        = shift;
     17     my ($key,$val)  = @_;
     18     $self->{_container}->{$key} = $val;
     19     return 1;
     20 }
     21
     22 sub get {
     23     my $self        = shift;
     24     my $key         = shift;
     25     return $self->{_container}->{$key} if exists $self->{_container}->{$key};
     26 }
     27
     28
     29 1;

Test::Simpleのコード

      1 #!/usr/local/bin/perl
      2
      3 # Class Structを使わないパターン
      4
      5 use strict;
      6 use warnings;
      7 use Test::Simple tests => 9;
      8 use DataContainer;
      9
     10 my $data    = new DataContainer();
     11 my $ret1    = $data->set("aaa", "bbb");
     12 my $ret2    = $data->set("ccc", "ddd");
     13
     14 ok ( $ret1 == 1, '$data->set() #1 set string');
     15 ok ( $ret2 == 1, '$data->set() #2 set string ');
     16 ok ( $data->get("aaa") eq "bbb", '$data->get() #1 get string');
     17 ok ( $data->get("ccc") eq "ddd", '$data->get() #2 get string');
     18 ok ( $data->get("eee") eq "",    '$data->get() #3 not exists key');
     19
     20 my @array   = ( 1, 2, 3 );
     21 my %hash    = ( "111"=>"222", "333"=>"444");
     22 my $ret3    = $data->set("sage", @array);
     23 my $ret4    = $data->set("age" , %hash);
     24
     25 ok ( $ret3 == 1, '$data->set() set array ');
     26 ok ( $ret4 == 1, '$data->set() set hash ');
     27
     28 my @sage_array = $data->get("sage");
     29 my %age_hash   = $data->get("age");
     30
     31 ok ( $sage_array[1] == 2, '$data->get() get array');
     32 ok ( $age_hash{"111"} eq "222", '$data->get() get array');
     33
     34 1;

でもって結果。

    1..9
    ok 1 - $data->set() \#1 set string
    ok 2 - $data->set() \#2 set string
    ok 3 - $data->get() \#1 get string
    ok 4 - $data->get() \#2 get string
    ok 5 - $data->get() \#3 not exists key
    ok 6 - $data->set() set array
    ok 7 - $data->set() set hash
    Odd number of elements in hash assignment at test3.t line 29.
    Use of uninitialized value in numeric eq (==) at test3.t line 31.
    not ok 8 - $data->get() get array
    #   Failed test '$data->get() get array'
    #   in test3.t at line 31.
    Use of uninitialized value in string eq at test3.t line 32.
    not ok 9 - $data->get() get array
    #   Failed test '$data->get() get array'
    #   in test3.t at line 32.
    # Looks like you failed 2 tests of 9.

おうふぁっく。
配列やハッシュはvaluesに入れちゃ駄目なのか。
17行目でスカラーきめうちだからかな。
perlってスクリプト言語にしてはかなり型に煩いですね。
嫌いじゃないですけど。

スクリプト言語は先にテストを書きたい人なので、
順番を無視してTest::MoreやTest::Harnessの取得に走るのです。