← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to t/seqwithquality.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/seqwithquality.t
1
 
# -*-Perl-*-
2
 
## Bioperl Test Harness Script for Modules
3
 
## $Id: seqwithquality.t,v 1.9 2005/07/11 14:40:49 heikki Exp $
4
 
 
5
 
use strict;
6
 
use Dumpvalue;
7
 
 
8
 
BEGIN {
9
 
        # to handle systems with no installed Test module
10
 
        # we include the t dir (where a copy of Test.pm is located)
11
 
        # as a fallback
12
 
    eval { require Test; };
13
 
    if( $@ ) {
14
 
        use lib 't';
15
 
    }
16
 
    use Test;
17
 
    plan tests => 20;
18
 
}
19
 
 
20
 
 
21
 
my $dumper = new Dumpvalue();
22
 
my $DEBUG = $ENV{'BIOPERLDEBUG'};
23
 
 
24
 
        # redirect STDERR to STDOUT
25
 
open (STDERR, ">&STDOUT");
26
 
 
27
 
my $verbosity = -1;
28
 
 
29
 
print("Checking if the Bio::Seq::SeqWithQuality module could be used...\n") if $DEBUG;
30
 
        # test 1
31
 
use Bio::Seq::SeqWithQuality;
32
 
ok(1);
33
 
 
34
 
use Bio::PrimarySeq;
35
 
use Bio::Seq::PrimaryQual;
36
 
 
37
 
# create some random sequence object with no id
38
 
my $seqobj_broken = Bio::PrimarySeq->new( -seq => "ATCGATCGA",
39
 
                            );
40
 
        # dumpValue($seqobj_broken);
41
 
 
42
 
my $seqobj = Bio::PrimarySeq->new( -seq => "ATCGATCGA",
43
 
                            -id  => 'QualityFragment-12',
44
 
                            -accession_number => 'X78121',
45
 
                            -verbose => $verbosity
46
 
                            );
47
 
ok(!$@);
48
 
 
49
 
 
50
 
# create some random quality object with the same number of qualities and the same identifiers
51
 
my $string_quals = "10 20 30 40 50 40 30 20 10";
52
 
my $indices = "5 10 15 20 25 30 35 40 45";
53
 
my $qualobj;
54
 
eval {
55
 
$qualobj = Bio::Seq::PrimaryQual->new( -qual => $string_quals,
56
 
                            -id  => 'QualityFragment-12',
57
 
                            -accession_number => 'X78121',
58
 
                            -verbose => $verbosity
59
 
                            );
60
 
};
61
 
ok(!$@);
62
 
 
63
 
 
64
 
     # check to see what happens when you construct the SeqWithQuality object
65
 
my $swq1 = Bio::Seq::SeqWithQuality->new( -seq  =>      $seqobj,
66
 
                                         -verbose => $verbosity,
67
 
                                        -qual           =>      $qualobj);
68
 
ok(!$@);
69
 
no warnings;
70
 
 
71
 
print("Testing various weird constructors...\n") if $DEBUG;
72
 
print("\ta) No ids, Sequence object, no quality...\n") if $DEBUG;
73
 
        # w for weird
74
 
my $wswq1;
75
 
eval {
76
 
        $wswq1 = Bio::Seq::SeqWithQuality->new( -seq  =>        $seqobj,
77
 
                                                -verbose => $verbosity,
78
 
                                                -qual   =>      "");
79
 
};
80
 
ok(!$@);
81
 
 
82
 
print("\tb) No ids, no sequence, quality object...\n") if $DEBUG;
83
 
        # note that you must provide a alphabet for this one.
84
 
$wswq1 = Bio::Seq::SeqWithQuality->new( -seq => "",
85
 
                                        -verbose => $verbosity,
86
 
                                        -qual => $qualobj,
87
 
                                        -alphabet => 'dna'
88
 
);
89
 
print("\tc) Absolutely nothing. (HAHAHAHA)...\n") if $DEBUG;
90
 
eval {
91
 
        $wswq1 = Bio::Seq::SeqWithQuality->new( -seq => "",
92
 
                                                -verbose => $verbosity,
93
 
                                                -qual => "",
94
 
                                                -alphabet => 'dna'
95
 
        );
96
 
};
97
 
ok(!$@);
98
 
print("\td) Absolutely nothing but an ID\n") if $DEBUG;
99
 
eval {
100
 
        $wswq1 = Bio::Seq::SeqWithQuality->new( -seq => "",
101
 
                                                -verbose => $verbosity,
102
 
                                                -qual => "",
103
 
                                                -alphabet => 'dna',
104
 
                                                -id => 'an object with no sequence and no quality but with an id'
105
 
        );
106
 
};
107
 
ok(!$@);
108
 
 
109
 
print("\td) No sequence, No quality, No ID...\n") if $DEBUG;
110
 
 
111
 
eval {
112
 
        $wswq1 = Bio::Seq::SeqWithQuality->new( -seq  =>        "",
113
 
                                                -verbose => $verbosity,
114
 
                                                        -qual   =>      "");
115
 
};
116
 
        # this should fail without a alphabet
117
 
ok($@);
118
 
        # dumpValue($wswq1);
119
 
 
120
 
 
121
 
 
122
 
 
123
 
 
124
 
print("Testing various methods and behaviors...\n") if $DEBUG;
125
 
 
126
 
print("1. Testing the seq() method...\n") if $DEBUG;
127
 
        print("\t1a) get\n") if $DEBUG;
128
 
        my $original_seq = $swq1->seq();
129
 
        ok ($original_seq eq "ATCGATCGA");
130
 
        print("\t1b) set\n") if $DEBUG;
131
 
        ok ($swq1->seq("AAAAAAAAAAAA"));
132
 
        print("\t1c) get (again, to make sure the set was done.)\n") if $DEBUG;
133
 
        ok($swq1->seq() eq "AAAAAAAAAAAA");
134
 
        print("\tSetting the sequence back to the original value...\n") if $DEBUG;
135
 
        $swq1->seq($original_seq);
136
 
 
137
 
print("2. Testing the qual() method...\n") if $DEBUG;
138
 
        print("\t2a) get\n") if $DEBUG;
139
 
        my @qual = @{$swq1->qual()};
140
 
        my $str_qual = join(' ',@qual);
141
 
        ok ($str_qual eq "10 20 30 40 50 40 30 20 10");
142
 
        print("\t2b) set\n") if $DEBUG;
143
 
        ok ($swq1->qual("10 10 10 10 10"));
144
 
        print("\t2c) get (again, to make sure the set was done.)\n") if $DEBUG;
145
 
        my @qual2 = @{$swq1->qual()};
146
 
        my $str_qual2 = join(' ',@qual2);
147
 
        ok($str_qual2 eq "10 10 10 10 10");
148
 
        print("\tSetting the quality back to the original value...\n") if $DEBUG;
149
 
        $swq1->qual($str_qual);
150
 
 
151
 
print("3. Testing the length() method...\n") if $DEBUG;
152
 
        print("\t3a) When lengths are equal...\n") if $DEBUG;
153
 
        ok($swq1->length() == 9);       
154
 
        print("\t3b) When lengths are different\n") if $DEBUG;
155
 
        $swq1->qual("10 10 10 10 10");
156
 
        # why is this test failing?
157
 
        # dumpValue($swq1);
158
 
ok($swq1->length() eq "DIFFERENT");
159
 
 
160
 
 
161
 
print("4. Testing the qual_obj() method...\n") if $DEBUG;
162
 
        print("\t4a) Testing qual_obj()...\n") if $DEBUG;
163
 
                my $retr_qual_obj = $swq1->qual_obj();
164
 
                ok (ref($retr_qual_obj) eq "Bio::Seq::PrimaryQual");
165
 
        print("\t4b) Testing qual_obj(\$ref)...\n") if $DEBUG;
166
 
                $swq1->qual_obj($qualobj);
167
 
 
168
 
print("5. Testing the seq_obj() method...\n") if $DEBUG;
169
 
        print("\t5a) Testing seq_qual_obj()...\n") if $DEBUG;
170
 
                my $retr_seq_obj = $swq1->seq_obj();
171
 
                ok (ref($retr_seq_obj) eq "Bio::PrimarySeq");
172
 
        print("\t5b) Testing seq_obj(\$ref)...\n") if $DEBUG;
173
 
                $swq1->seq_obj($seqobj);
174
 
 
175
 
print("6. Testing the subqual() method...\n") if $DEBUG;
176
 
     my $t_subqual = "10 20 30 40 50 60 70 80 90";
177
 
     $swq1->qual($t_subqual);
178
 
     print("\t6d) Testing the subqual at the start (border condition)\n") if $DEBUG;
179
 
          # ok ('1 2 3' eq join(' ',@{$swq1->subqual(1,3)}));
180
 
     print("\t6d) Testing the subqual at the end (border condition)\n") if $DEBUG;
181
 
          # ok ('7 8 9' eq join(' ',@{$swq1->subqual(7,9)}));
182
 
     print("\t6d) Testing the subqual in the middle\n") if $DEBUG;
183
 
          # ok ('4 5 6' eq join(' ',@{$swq1->subqual(4,6)}));
184
 
 
185
 
 
186
 
print("7. Testing cases where quality is zero...\n") if $DEBUG;
187
 
$swq1 = Bio::Seq::SeqWithQuality->new(-seq =>  'G',
188
 
                                      -qual => '0',
189
 
                                      -verbose => $verbosity,
190
 
                                     );
191
 
my $swq2 = Bio::Seq::SeqWithQuality->new(-seq =>  'G',
192
 
                                         -qual => '65',
193
 
                                         -verbose => $verbosity,
194
 
                                     );
195
 
ok  $swq1->length, $swq2->length;
196
 
 
197
 
$swq1 = Bio::Seq::SeqWithQuality->new(-seq =>  'GC',
198
 
                                      -verbose => $verbosity,
199
 
                                      -qual => '0 0',
200
 
                                     );
201
 
$swq2 = Bio::Seq::SeqWithQuality->new(-seq =>  'GT',
202
 
                                      -verbose => $verbosity,
203
 
                                      -qual => '65 0',
204
 
                                     );
205
 
ok  $swq1->length, $swq2->length;