オプション解析をテストする

前に書いたように、レガシーコードを再構成する場合、テストコードを書かないと容易に死んでしまえます。それじゃあ困るので、テストコードをちゃんと書きます。

お題は前回の my_prog.pl を使います。最終ゴールも前回のコードとします。

#!/usr/bin/perl -w

$a_str = undef;

read_args();
print "-a オプションで渡された値 : $a_str\n" if ( defined $a_str );
# 本当は main な処理が続く...

sub read_args {
  while( $_ = shift @ARGV ) {
    if ( $_ =~ /^-h$/ ) {
      usage();
    }
    elsif ( $_ =~ /^-a$/ ) {
      $a_str = shift @ARGV;
      if ( ! defined $a_str ) {
        usage();
      }
    }
  }
}

sub usage {
  print "my_prog.pl [-h] [-a somestring]\n";
  exit;
}

まず、このままじゃ使えないので、とりあえずモジュール化します。main 処理を省き、package 化します。名前も変えちゃいましょう。

% cp my_prog.pl my_prog.pm

my_prog.pm を編集します。

#!/usr/bin/perl -w
package my_prog;
$a_str = undef;

#read_args();
#print "-a オプションで渡された値 : $a_str\n" if ( defined $a_str );
## 本当は main な処理が続く...

sub read_args {
  while( $_ = shift @ARGV ) {
    if ( $_ =~ /^-h$/ ) {
      usage();
    }
    elsif ( $_ =~ /^-a$/ ) {
      $a_str = shift @ARGV;
      if ( ! defined $a_str ) {
        usage();
      }
    }
  }
}

sub usage {
  print "my_prog.pl [-h] [-a somestring]\n";
  exit;
}
1;

実際の作業ならコメントアウトじゃなくて削除でもいいです。

ではとりあえず、コレのテストコードを書きます。
まずは簡単そう(?)な -h オプションのテストコードを書きます

#!/usr/bin/perl

use strict;
use warnings;

ReadArgsTest->runtests;

package ReadArgsTest;
use base qw(Test::Class);

use my_prog;
use Test::More "no_plan";

sub h_option_test : Test(1) {
  {
    local @ARGV = ("-h");
    local *STDOUT;

    open(STDOUT, '>', 'stdout.txt');
    my_prog::read_args();
    close(STDOUT);
    is(_stdout(), "my_prog.pl [-h] [-a somestring]\n");
  }
}

sub _stdout {
  open(my $stdout_file, '<', 'stdout.txt');
  my $data = do { local $/; <$stdout_file> };
  close($stdout_file);
  return $data;
}

sub setup : Test(setup) {
  unlink('stdout.txt') if -e 'stdout.txt';
}

で、コレを実行！

% prove 01_my_prog.t
01_my_prog....# No tests run!
01_my_prog.... Dubious, test returned 255 (wstat 65280, 0xff00)
 No subtests run 

Test Summary Report
-------------------
01_my_prog (Wstat: 65280 Tests: 0 Failed: 0)
  Non-zero exit status: 255
  Parse errors: No plan found in TAP output
Files=1, Tests=0,  0 wallclock secs ( 0.00 usr  0.05 sys +  0.01 cusr  0.08 csys =  0.14 CPU)
Result: FAIL
Failed 1/1 test programs. 0/0 subtests failed.

あれ？ No tests run です...。

これ、すごく悩みました。何がダメかというと、exit なんです。テストする前に exit しちゃうから。

もし、exit を書き換えることができないのなら、多分あきらめるしかないです。僕の場合は print + exit を die に置き換えても動作上問題なかったので、そうしました。

die に変えると、テストコードもかなり簡単に書けます。

まず本コード(usage だけ抜粋)

sub usage {
  die "my_prog.pl [-h] [-a somestring]\n";
}

次にテストコード

#!/usr/bin/perl

use strict;
use warnings;

ReadArgsTest->runtests;

package ReadArgsTest;
use base qw(Test::Class);

use my_prog;
use Test::More "no_plan";

sub h_option_test : Test(1) {
  {
    local @ARGV = ("-h");

    eval { my_prog::read_args();  };
    
    is($@, "my_prog.pl [-h] [-a somestring]\n");
  }
}

STDOUT を無理矢理捕まえる必要が無くなったので、だいぶ良くなりました。実行してみます。

% prove 01_my_prog.t 
01_my_prog....ok   
All tests successful.
Files=1, Tests=1,  0 wallclock secs ( 0.00 usr  0.05 sys +  0.02 cusr  0.07 csys =  0.14 CPU)
Result: PASS

通りました。

では他のオプションのテストコードも書きます。
こんな感じになりました。

#!/usr/bin/perl

use strict;
use warnings;

ReadArgsTest->runtests;

package ReadArgsTest;
use base qw(Test::Class);

use my_prog;
use Test::More "no_plan";

sub h_option_test : Test(2) {
  {
    local @ARGV = ("-h");

    eval { my_prog::read_args();  };

    is($@, "my_prog.pl [-h] [-a somestring]\n");
    ok( !defined $my_prog::a_str);
  }
}

sub a_option_no_arg_test : Test(2) {
  {
    local @ARGV = ("-a");

    eval { my_prog::read_args();  };

    is($@, "my_prog.pl [-h] [-a somestring]\n");
    ok( !defined $my_prog::a_str);
  }
}

sub a_option_with_arg_test : Test(2) {
  {
    local @ARGV = ("-a", "a_value");

    eval { my_prog::read_args();  };

    is($@, "");
    is($my_prog::a_str, "a_value");
  }
}

sub setup : Test(setup) {
  $my_prog::a_str = undef;
}

もっと書きたいのですが、とりあえず今日はこれでおしまい。次回は my_prog.pm をリファクタリングしていきます。(予定)