← Back to branch summary

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

« back to all changes in this revision

Viewing changes to t/Seq/PrimarySeq.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/PrimarySeq.t
 
1
# -*-Perl-*- Test Harness script for Bioperl
 
2
# $Id: PrimarySeq.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 => 53);
 
11
        
 
12
    use_ok('Bio::PrimarySeq');
 
13
    use_ok('Bio::Location::Simple');
 
14
    use_ok('Bio::Location::Fuzzy');
 
15
    use_ok('Bio::Location::Split');
 
16
}
 
17
 
 
18
my $seq = Bio::PrimarySeq->new(
 
19
                                         '-seq'            => 'TTGGTGGCGTCAACT',
 
20
                               '-display_id'       => 'new-id',
 
21
                               '-alphabet'         => 'dna',
 
22
                               '-accession_number' => 'X677667',
 
23
                               '-desc'             => 'Sample Bio::Seq object');
 
24
ok defined $seq;
 
25
isa_ok $seq,'Bio::PrimarySeqI';
 
26
is $seq->accession_number(), 'X677667';
 
27
is $seq->seq(), 'TTGGTGGCGTCAACT';
 
28
is $seq->display_id(), 'new-id';
 
29
is $seq->alphabet(), 'dna';
 
30
is $seq->is_circular(), undef;
 
31
ok $seq->is_circular(1);
 
32
is $seq->is_circular(0), 0;
 
33
 
 
34
# check IdentifiableI and DescribableI interfaces
 
35
isa_ok $seq,'Bio::IdentifiableI';
 
36
isa_ok $seq,'Bio::DescribableI';
 
37
# make sure all methods are implemented
 
38
is $seq->authority("bioperl.org"), "bioperl.org";
 
39
is $seq->namespace("t"), "t";
 
40
is $seq->version(0), 0;
 
41
is $seq->lsid_string(), "bioperl.org:t:X677667";
 
42
is $seq->namespace_string(), "t:X677667.0";
 
43
is $seq->description(), 'Sample Bio::Seq object';
 
44
is $seq->display_name(), "new-id";
 
45
 
 
46
my $location = Bio::Location::Simple->new('-start' => 2, 
 
47
                                                                                                          '-end' => 5,
 
48
                                                                                                          '-strand' => -1);
 
49
is ($seq->subseq($location), 'ACCA');
 
50
 
 
51
my $splitlocation = Bio::Location::Split->new();
 
52
$splitlocation->add_sub_Location( Bio::Location::Simple->new(
 
53
                                                                 '-start' => 1,
 
54
                                                            '-end'   => 4,
 
55
                                                            '-strand' => 1));
 
56
 
 
57
$splitlocation->add_sub_Location( Bio::Location::Simple->new(
 
58
                         '-start' => 7,
 
59
                                                            '-end'   => 12,
 
60
                                                            '-strand' => -1));
 
61
 
 
62
is( $seq->subseq($splitlocation), 'TTGGTGACGC');
 
63
 
 
64
my $fuzzy = Bio::Location::Fuzzy->new(-start => '<3',
 
65
                                                                                                 -end   => '8',
 
66
                                                                                                 -strand => 1);
 
67
 
 
68
is( $seq->subseq($fuzzy), 'GGTGGC');
 
69
 
 
70
my $trunc = $seq->trunc(1,4);
 
71
isa_ok $trunc, 'Bio::PrimarySeqI';
 
72
is $trunc->seq(), 'TTGG' or diag("Expecting TTGG. Got ".$trunc->seq());
 
73
 
 
74
$trunc = $seq->trunc($splitlocation);
 
75
isa_ok($trunc, 'Bio::PrimarySeqI');
 
76
is( $trunc->seq(), 'TTGGTGACGC');
 
77
 
 
78
$trunc = $seq->trunc($fuzzy);
 
79
isa_ok($trunc, 'Bio::PrimarySeqI');
 
80
is( $trunc->seq(), 'GGTGGC');
 
81
 
 
82
my $rev = $seq->revcom();
 
83
isa_ok($rev, 'Bio::PrimarySeqI');
 
84
 
 
85
is $rev->seq(), 'AGTTGACGCCACCAA' or diag('revcom() failed, was ' . $rev->seq());
 
86
 
 
87
#
 
88
# Translate
 
89
#
 
90
 
 
91
my $aa = $seq->translate(); # TTG GTG GCG TCA ACT
 
92
is $aa->seq, 'LVAST', "Translation: ". $aa->seq;
 
93
 
 
94
# tests for non-standard initiator codon coding for
 
95
# M by making translate() look for an initiator codon and
 
96
# terminator codon ("complete", the 5th argument below)
 
97
$seq->seq('TTGGTGGCGTCAACTTAA'); # TTG GTG GCG TCA ACT TAA
 
98
$aa = $seq->translate(undef, undef, undef, undef, 1);
 
99
is $aa->seq, 'MVAST', "Translation: ". $aa->seq;
 
100
 
 
101
# same test as previous, but using named parameter
 
102
$aa = $seq->translate(-complete => 1);
 
103
is $aa->seq, 'MVAST', "Translation: ". $aa->seq;
 
104
 
 
105
# find ORF, ignore codons outside the ORF or CDS
 
106
$seq->seq('TTTTATGGTGGCGTCAACTTAATTT'); # ATG GTG GCG TCA ACT
 
107
$aa = $seq->translate(-orf => 1);
 
108
is $aa->seq, 'MVAST*', "Translation: ". $aa->seq;
 
109
 
 
110
# smallest possible ORF
 
111
$seq->seq("ggggggatgtagcccc"); # atg tga
 
112
$aa = $seq->translate(-orf => 1);
 
113
is $aa->seq, 'M*', "Translation: ". $aa->seq;
 
114
 
 
115
# same as previous but complete, so * is removed
 
116
$aa = $seq->translate(-orf => 1,
 
117
                      -complete => 1);
 
118
is $aa->seq, 'M', "Translation: ". $aa->seq;
 
119
 
 
120
# ORF without termination codon
 
121
# should warn, let's change it into throw for testing
 
122
$seq->verbose(2);
 
123
$seq->seq("ggggggatgtggcccc"); # atg tgg ccc
 
124
eval { $seq->translate(-orf => 1); };
 
125
if ($@) {
 
126
    like( $@, qr/atgtggcccc\n/);
 
127
        $seq->verbose(-1);
 
128
        $aa = $seq->translate(-orf => 1);
 
129
    is $aa->seq, 'MWP', "Translation: ". $aa->seq;
 
130
}
 
131
$seq->verbose(0);
 
132
 
 
133
# use non-standard codon table where terminator is read as Q
 
134
$seq->seq('ATGGTGGCGTCAACTTAG'); # ATG GTG GCG TCA ACT TAG
 
135
$aa = $seq->translate(-codontable_id => 6);
 
136
is $aa->seq, 'MVASTQ' or diag("Translation: ". $aa->seq);
 
137
 
 
138
# insert an odd character instead of terminating with *
 
139
$aa = $seq->translate(-terminator => 'X');
 
140
is $aa->seq, 'MVASTX' or diag("Translation: ". $aa->seq);
 
141
 
 
142
# change frame from default
 
143
$aa = $seq->translate(-frame => 1); # TGG TGG CGT CAA CTT AG
 
144
is $aa->seq, 'WWRQL' or diag("Translation: ". $aa->seq);
 
145
 
 
146
$aa = $seq->translate(-frame => 2); # GGT GGC GTC AAC TTA G
 
147
is $aa->seq, 'GGVNL' or diag("Translation: ". $aa->seq);
 
148
 
 
149
# TTG is initiator in Standard codon table? Afraid so.
 
150
$seq->seq("ggggggttgtagcccc"); # ttg tag
 
151
$aa = $seq->translate(-orf => 1);
 
152
is $aa->seq, 'L*' or diag("Translation: ". $aa->seq);
 
153
 
 
154
# Replace L at 1st position with M by setting complete to 1 
 
155
$seq->seq("ggggggttgtagcccc"); # ttg tag
 
156
$aa = $seq->translate(-orf => 1,
 
157
                                                         -complete => 1);
 
158
is $aa->seq, 'M' or diag("Translation: ". $aa->seq);
 
159
 
 
160
# Ignore non-ATG initiators (e.g. TTG) in codon table
 
161
$seq->seq("ggggggttgatgtagcccc"); # atg tag
 
162
$aa = $seq->translate(-orf => 1,
 
163
                                                         -start => "atg",
 
164
                                                         -complete => 1);
 
165
is $aa->seq, 'M' or diag("Translation: ". $aa->seq);
 
166
 
 
167
 
 
168
# test for character '?' in the sequence string
 
169
is $seq->seq('TTGGTGGCG?CAACT'), 'TTGGTGGCG?CAACT';
 
170
 
 
171
# test for some aliases
 
172
$seq = Bio::PrimarySeq->new(-id          => 'aliasid',
 
173
                                                                         -description => 'Alias desc');
 
174
is($seq->description, 'Alias desc');
 
175
is($seq->display_id, 'aliasid');
 
176
 
 
177
# test that x's are ignored and n's are assumed to be 'dna' no longer true!
 
178
# See Bug 2438. There are protein sequences floating about which are all 'X'
 
179
# (unknown aa)
 
180
 
 
181
$seq->seq('atgxxxxxx');
 
182
is($seq->alphabet,'protein');
 
183
$seq->seq('atgnnnnnn');
 
184
is($seq->alphabet,'dna');