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