1# -*-Perl-*- Test Harness script for Bioperl
2# $Id$
3
4use strict;
5
6BEGIN {
7    use Bio::Root::Test;
8
9    test_begin(-tests => 76);
10
11    use_ok('Bio::Seq');
12    use_ok('Bio::Seq::RichSeq');
13    use_ok('Bio::SeqFeature::Generic');
14    use_ok('Bio::Species');
15    use_ok('Bio::Annotation::SimpleValue');
16}
17
18ok my $seq = Bio::Seq->new(-seq=>'ACTGTGGCGTCAACT',
19                        -desc=>'Sample Bio::Seq object',
20                        -alphabet => 'dna',
21                        -is_circular => 1
22                       );
23isa_ok($seq,"Bio::AnnotatableI");
24
25ok $seq->is_circular;
26ok not $seq->is_circular(0);
27ok not $seq->is_circular;
28
29my $trunc = $seq->trunc(1,4);
30is $trunc->length, 4, 'truncated sequence length';
31
32is $trunc->seq, 'ACTG', 'truncated sequence string';
33
34# test ability to get str function
35is $seq->seq(),  'ACTGTGGCGTCAACT' ;
36
37ok $seq = Bio::Seq->new(-seq=>'actgtggcgtcaact',
38                        -desc=>'Sample Bio::Seq object',
39                        -display_id => 'something',
40                        -accession_number => 'accnum',
41                        -alphabet => 'dna' );
42
43is uc $seq->alphabet, 'DNA' , 'alphabet';
44
45# basic methods
46
47is $seq->id(), 'something',  "id";
48is $seq->accession_number, 'accnum', "accession number";
49is $seq->subseq(5, 9),  'tggcg', "subseq";
50
51# check IdentifiableI and DescribableI interfaces
52isa_ok $seq, 'Bio::IdentifiableI';
53isa_ok $seq, 'Bio::DescribableI';
54# make sure all methods are implemented
55is $seq->authority("bioperl.org"), "bioperl.org";
56is $seq->namespace("t"), "t";
57is $seq->version(0), 0;
58is $seq->lsid_string(), "bioperl.org:t:accnum";
59is $seq->namespace_string(), "t:accnum.0";
60is $seq->description(), 'Sample Bio::Seq object';
61is $seq->display_name(), "something";
62
63# check that feature accession works regardless of lazy things going on
64is scalar($seq->top_SeqFeatures()), 0;
65is scalar($seq->flush_SeqFeatures()), 0;
66
67my $newfeat = Bio::SeqFeature::Generic->new( -start => 10,
68                                             -end => 12,
69                                             -primary => 'silly',
70                                             -source => 'stuff');
71
72
73$seq->add_SeqFeature($newfeat);
74is $seq->feature_count, 1;
75
76my $species = Bio::Species->new
77    (-verbose => 1,
78     -classification => [ qw( sapiens Homo Hominidae
79                              Catarrhini Primates Eutheria
80                              Mammalia Vertebrata Chordata
81                              Metazoa Eukaryota )]);
82$seq->species($species);
83is $seq->species->binomial, 'Homo sapiens';
84$seq->annotation->add_Annotation('description',
85                 Bio::Annotation::SimpleValue->new(-value => 'desc-here'));
86my ($descr) = $seq->annotation->get_Annotations('description');
87is $descr->value(), 'desc-here';
88is $descr->tagname(), 'description';
89
90#
91#  translation tests
92#
93
94my $trans = $seq->translate();
95is  $trans->seq(), 'TVAST' , 'translated sequence';
96
97# unambiguous two character codons like 'ACN' and 'GTN' should give out an amino
98# acid ...with the addendum that there should be no assumption by the method
99# to complete the codon unless specified, using the -complete_codons flag.
100
101$seq->seq('ACTGTGGCGTCAACN');
102$trans = $seq->translate();
103is $trans->seq(), 'TVAST', 'translated sequence with explicit unambiguous codons';
104
105$seq->seq('ACTGTGGCGTCAAC');
106$trans = $seq->translate();
107is $trans->seq(), 'TVAS', 'translated sequence with unknown unambiguous codons';
108
109$seq->seq('ACTGTGGCGTCAAC');
110$trans = $seq->translate(-complete_codons => 1);
111is $trans->seq(), 'TVAST', 'translated sequence with unknown unambiguous codons, completed';
112
113$seq->seq('ACTGTGGCGTCAACA');
114$trans = $seq->translate();
115is $trans->seq(), 'TVAST', 'translated sequence with unambiguous codons';
116
117$seq->seq('ACTGTGGCGTCAACAG');
118$trans = $seq->translate();
119is $trans->seq(), 'TVAST', 'translated sequence with unambiguous codons';
120
121$seq->seq('ACTGTGGCGTCAACAGT');
122$trans = $seq->translate(-complete_codons => 1);
123is $trans->seq(), 'TVASTV', 'translated sequence with unknown unambiguous codons, completed';
124
125$seq->seq('ACTGTGGCGTCAACAGTA');
126$trans = $seq->translate();
127is $trans->seq(), 'TVASTV', 'translated sequence with unambiguous codons';
128
129$seq->seq('AC');
130is $seq->translate(-complete_codons => 1)->seq , 'T', 'translated sequence with unknown unambiguous codons, completed';
131
132#difference between the default and full CDS translation
133
134$seq->seq('atgtggtaa');
135$trans = $seq->translate();
136is $trans->seq(), 'MW*' , 'translated sequence with stop';
137
138$seq->seq('atgtggtaa');
139$trans = $seq->translate(undef,undef,undef,undef,1);
140is $trans->seq(), 'MW', 'translated sequence';
141
142#frame
143my $string;
144my @frames = (0, 1, 2);
145foreach my $frame (@frames) {
146    $string .= $seq->translate(undef, undef, $frame)->seq;
147    $string .= $seq->revcom->translate(undef, undef, $frame)->seq;
148}
149is $string, 'MW*LPHCGYHVVTT';
150
151#Translating with all codon tables using method defaults
152$string = '';
153my @codontables = qw(0 1 2 3 4 5 6 9 10 11 12 13 14 16 21
154    22 23 24 25 26 27 28 29 30 31);
155foreach my $ct (@codontables) {
156    $string .= $seq->translate(undef, undef, undef, $ct)->seq;
157}
158is $string, 'MW*MW*MW*MW*MW*MW*MWQMW*MW*MW*MW*MW*MWYMW*MW*MW*MW*MW*MW*MW*MWQMWQMWYMWEMWE';
159
160# CDS translation set to throw an exception for internal stop codons
161$seq->seq('atgtggtaataa');
162eval {
163    $seq->translate(undef, undef, undef, undef, 'CDS' , 'throw');
164};
165like ($@, qr/EX/);
166
167$seq->seq('atgtggtaataa');
168is( $seq->translate('J', '-',)->seq, 'MWJJ');
169
170# tests for RichSeq
171ok my $richseq = Bio::Seq::RichSeq->new( -seq => 'atgtggtaataa',
172                                      -accession_number => 'AC123',
173                                      -alphabet => 'rna',
174                                      -molecule => 'mRNA',
175                                      -id => 'id1',
176                                      -dates => [ '2001/1/1' ],
177                                      -pid => '887821',
178                                      -keywords => 'JUNK1;JUNK2',
179                                      -division => 'Fungi',
180                                      -secondary_accessions => 'AC1152' );
181
182is ($richseq->seq, 'atgtggtaataa');
183is ($richseq->display_id, 'id1');
184is (($richseq->get_dates)[0], '2001/1/1');
185is (($richseq->get_secondary_accessions)[0], 'AC1152');
186is ($richseq->accession_number, 'AC123');
187is ($richseq->alphabet, 'rna');
188is ($richseq->molecule, 'mRNA');
189is ($richseq->pid, 887821);
190is ($richseq->division, 'Fungi');
191is ($richseq->keywords, 'JUNK1; JUNK2');
192$richseq->seq_version('2');
193is ($richseq->seq_version, 2);
194
195# Test adding a feature to a RichSeq type, then
196# trunc() and see if the feature vanishes (we shouldn't
197# be using clone() for RichSeq types)
198$richseq->add_SeqFeature($newfeat);
199is $richseq->feature_count, 1;
200my $newrichseq = $richseq->trunc(1,5);
201is $newrichseq->feature_count, 0, "Don't use clone for trunc of Bio::Seq::RichSeq";
202is $newrichseq->length, 5;
203
204# tests for subtle misbehaviors
205$seq = Bio::Seq->new(-primary_id => 'blah', -accession_number => 'foo');
206is ($seq->accession_number, $seq->primary_seq->accession_number);
207is ($seq->primary_id, $seq->primary_seq->primary_id);
208$seq->accession_number('blurb');
209$seq->primary_id('bar');
210is ($seq->accession_number, $seq->primary_seq->accession_number);
211is ($seq->primary_id, $seq->primary_seq->primary_id);
212
213
214# Bug #2864:
215
216$seq = Bio::Seq->new(-display_id => 0, -seq => 'GATC');
217
218is $seq->display_id, 0, "Bug #2864";
219
220# transcribe/rev_transcribe
221
222$seq = Bio::Seq->new( -id => 'seq1', -alphabet=>'dna',
223                      -seq=> 'attTcgcatgT' );
224ok my $xseq = $seq->transcribe;
225is $xseq->alphabet, 'rna';
226ok !($xseq->seq =~ /[tT]/);
227is $xseq->seq, 'auuUcgcaugU';
228ok !$xseq->transcribe;
229ok $seq = $xseq->rev_transcribe;
230is $seq->seq, 'attTcgcatgT';
231is $seq->alphabet, 'dna';
232