← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to t/Tools/Run/WrapperBase.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/Tools/Run/WrapperBase.t
 
1
# -*-Perl-*- Test Harness script for Bioperl
 
2
# $Id: WrapperBase.t 15112 2008-12-08 18:12:38Z sendu $
 
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';