← Back to branch summary

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

« back to all changes in this revision

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