branch-1-6/t/Tools/Run/WrapperBase.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 27);
  11
  12         use_ok('Bio::Tools::Run::WrapperBase');
  13 }
  14
  15 my @params = qw(test1 test_2);
  16 my @switches = qw(Test3 test_4);
  17 *Bio::Tools::Run::WrapperBase::new = sub {
  18         my ($class, @args) = @_;
  19     my $self = $class->Bio::Tools::Run::WrapperBase::SUPER::new(@args);
  20
  21     $self->_set_from_args(\@args, -methods => [@params, @switches],
  22                                   -create => 1);
  23
  24     return $self;
  25 };
  26 my $new = *Bio::Tools::Run::WrapperBase::new; # just to avoid warning
  27 my $obj = Bio::Tools::Run::WrapperBase->new(-test_2 => 2, -test3 => 1, -test_4 => 0);
  28 isa_ok($obj, 'Bio::Tools::Run::WrapperBase');
  29
  30 # it is interface-like with throw_not_implemented methods; check their
  31 # existance
  32 foreach my $method (qw(run program_dir program_name version)) {
  33         ok $obj->can($method), "$method() exists";
  34 }
  35
  36 ## most methods are defined; check their function
  37
  38 # simple get/setters
  39 foreach my $method (qw(error_string arguments no_param_checks save_tempfiles
  40                                            outfile_name quiet)) {
  41         $obj->$method(1);
  42         is $obj->$method(), 1, "$method could be set";
  43 }
  44
  45 # tempdir
  46
  47 $obj->save_tempfiles(0);
  48 my $tmpdir = $obj->tempdir();
  49 ok -d $tmpdir, 'tempdir created a directory';
  50 ok open(my $test, '>', File::Spec->catfile($tmpdir, 'test')), 'could create file in tempdir';
  51 print $test "test\n";
  52 close($test);
  53
  54 # cleanup
  55
  56 $obj->cleanup();
  57 ok ! -d $tmpdir, 'following cleanup() with save_tempfiles unset, tempdir was deleted';
  58
  59 # io
  60 my $io1 = $obj->io;
  61 my $io2 = $obj->io;
  62 isa_ok($io1, 'Bio::Root::IO');
  63 is $io1, $io2, 'io() always returns the same instance of IO';
  64
  65 # program_dir and program_name need to be defined for program_path and
  66 # executable to work
  67 {
  68         no warnings 'redefine';
  69         *Bio::Tools::Run::WrapperBase::program_dir = sub {
  70                 my $self = shift;
  71                 if (@_) { $self->{pdir} = shift }
  72                 return $self->{pdir} || '';
  73         };
  74         *Bio::Tools::Run::WrapperBase::program_name = sub {
  75                 my $self = shift;
  76                 if (@_) { $self->{pname} = shift }
  77                 return $self->{pname} || '';
  78         };
  79 }
  80 $obj->program_dir('test_dir');
  81 $obj->program_name('test_name');
  82
  83 # program_path
  84 is $obj->program_path, File::Spec->catfile('test_dir', 'test_name'.($^O =~ /mswin/i ?'.exe':'')), 'program_path was correct';
  85
  86 # executable
  87 ok ! $obj->executable, 'pretend program name not found as executable';
  88 $obj->program_name('perl');
  89 ok $obj->executable, 'perl found as exectuable';
  90
  91 # _setparams
  92 my $params = $obj->_setparams(-params => \@params,
  93                                                           -switches => \@switches);
  94 is $params, ' test_2 2 Test3', 'params string correct';
  95 $params = $obj->_setparams(-params => \@params,
  96                                                    -switches => \@switches,
  97                                                    -join => '=');
  98 is $params, ' test_2=2 Test3', 'params string correct';
  99 $params = $obj->_setparams(-params => \@params,
 100                                                    -switches => \@switches,
 101                                                    -join => '=',
 102                                                    -lc => 1);
 103 is $params, ' test_2=2 test3', 'params string correct';
 104 $params = $obj->_setparams(-params => \@params,
 105                                                    -switches => \@switches,
 106                                                    -join => '=',
 107                                                    -lc => 1,
 108                                                    -dash => 1);
 109 is $params, ' -test_2=2 -test3', 'params string correct';
 110 $params = $obj->_setparams(-params => \@params,
 111                                                    -switches => \@switches,
 112                                                    -join => '=',
 113                                                    -lc => 1,
 114                                                    -double_dash => 1);
 115 is $params, ' --test_2=2 --test3', 'params string correct';
 116 $params = $obj->_setparams(-params => \@params,
 117                                                    -switches => \@switches,
 118                                                    -join => '=',
 119                                                    -lc => 1,
 120                                                    -double_dash => 1,
 121                                                    -underscore_to_dash => 1);
 122 is $params, ' --test-2=2 --test3', 'params string correct';
 123 $params = $obj->_setparams(-params => {(test1 => 't1', test_2 => 't_2')},
 124                                                    -switches => {(Test3 => 'T3', test_4 => 't4')},
 125                                                    -join => '=',
 126                                                    -lc => 1,
 127                                                    -double_dash => 1,
 128                                                    -underscore_to_dash => 1);
 129 is $params, ' --t-2=2 --t3', 'params string correct';