~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to t/SeqIO.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
# -*-Perl-*- mode (to keep my emacs happy)
2
 
# $Id: SeqIO.t,v 1.77 2003/12/17 13:14:28 heikki Exp $
 
2
# $Id: SeqIO.t,v 1.99 2005/08/28 13:56:45 bosborne Exp $
3
3
 
4
4
use strict;
5
 
use vars qw($DEBUG $TESTCOUNT);
6
 
$DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
7
5
 
8
6
BEGIN {
9
 
    eval { require Test; };
10
 
    if( $@ ) {
11
 
use lib 't';
12
 
    }
13
 
    use Test;
14
 
    $TESTCOUNT = 235;
15
 
    plan tests => $TESTCOUNT;
 
7
        eval { require Test; };
 
8
        if ( $@ ) {
 
9
                use lib 't';
 
10
        }
 
11
        use Test;
 
12
        plan tests => 29;
16
13
}
17
14
 
18
 
use Bio::Seq;
19
15
use Bio::SeqIO;
20
 
use Bio::SeqIO::MultiFile;
21
 
use Bio::Root::IO;
22
 
use Bio::Annotation::Collection;
23
16
 
24
17
ok(1);
25
18
 
26
19
# Set to -1 for release version, so warnings aren't printed
27
 
my $verbosity = $DEBUG ? 1 : -1;
28
 
 
29
 
#
30
 
# Basic read and/or write tests
31
 
#
32
 
 
 
20
my $verbose = $ENV{'BIOPERLDEBUG'} || 0;
 
21
 
 
22
# Basic read and/or write tests for SeqIO. Specific tests for
 
23
# given module should go into their own file.
 
24
 
 
25
my @formats = qw(gcg fasta raw pir tab ace );
 
26
# The following files or formats are failing: swiss genbank interpro embl
 
27
 
 
28
foreach my $format (@formats) {
 
29
        print "======== $format ========\n" if $verbose;
 
30
        read_write($format);
 
31
}
33
32
 
34
33
sub read_write {
35
 
    my $format = shift;
36
 
    my $seq;
37
 
 
38
 
    my $str = Bio::SeqIO->new(-file=> Bio::Root::IO->catfile("t","data","test.$format"),
39
 
                              '-format' => $format);
40
 
    ok $seq = $str->next_seq();
41
 
    print "Sequence 1 of 2 from $format stream:\n", $seq->seq, "\n\n" if  $DEBUG;
42
 
 
43
 
    unless ($format eq 'raw') {
44
 
        ok $seq->id, 'roa1_drome',"ID for format $format";
45
 
        ok $seq->length, 358;
46
 
    }
47
 
 
48
 
    unless ($format eq 'gcg') { # GCG file can contain only one sequence
49
 
        ok $seq = $str->next_seq();
50
 
        print "Sequence 2 of 2 from $format stream:\n", $seq->seq, $seq->seq, "\n" if $DEBUG;
51
 
    }
52
 
 
53
 
    my $out = Bio::SeqIO->new('-file'=> ">". Bio::Root::IO->catfile("t","data","$format.out"),
54
 
                           '-format' => $format);
55
 
    ok $out->write_seq($seq);
56
 
    if ($format eq 'fasta') {
57
 
        my $id_type;
58
 
        ok($id_type = $out->preferred_id_type('accession.version'), 'accession.version');
59
 
    }
60
 
 
61
 
}
62
 
 
63
 
my @formats = qw(gcg fasta raw pir tab);
64
 
 
65
 
foreach my $format (@formats) {
66
 
    print "======== $format ========\n" if $DEBUG;
67
 
    read_write($format);
 
34
        my $format = shift;
 
35
        my $seq;
 
36
        my $str = Bio::SeqIO->new(-file=> Bio::Root::IO->catfile
 
37
                                                                          ("t","data","test.$format"),
 
38
                                                                          -format => $format);
 
39
        ok $seq = $str->next_seq();
 
40
        print "Sequence 1 of 2 from $format stream:\n", $seq->seq, "\n\n"
 
41
          if  $verbose;
 
42
        unless ($format eq 'raw') {
 
43
                ok $seq->id, 'roa1_drome',"ID for format $format";
 
44
                ok $seq->length, 358;
 
45
        }
 
46
 
 
47
        unless ($format eq 'gcg') { # GCG file can contain only one sequence
 
48
                ok $seq = $str->next_seq();
 
49
                print "Sequence 2 of 2 from $format stream:\n", $seq->seq,
 
50
                  $seq->seq, "\n" if $verbose;
 
51
        }
 
52
 
 
53
        my $out = Bio::SeqIO->new(-file => ">". Bio::Root::IO->catfile
 
54
                                                                          ("t","data","$format.out"),
 
55
                                                                          -format => $format);
 
56
        ok $out->write_seq($seq);
 
57
        if ($format eq 'fasta') {
 
58
                my $id_type;
 
59
                ok($id_type = $out->preferred_id_type('accession.version'),
 
60
                        'accession.version');
 
61
        }
68
62
}
69
63
 
70
64
END {
71
 
 
72
 
    map { unlink Bio::Root::IO->catfile("t","data","$_.out") } @formats
73
 
 
74
 
}
75
 
 
76
 
my ($str, $seq,$ast,$temp,$mf,$ent,$out); # predeclare variables for strict
77
 
# PIR testing
78
 
 
79
 
$str = Bio::SeqIO->new('-file' => Bio::Root::IO->catfile("t","data","seqfile.pir"),
80
 
                       '-format' => 'pir');
81
 
ok $str;
82
 
$out = new Bio::SeqIO(-format => 'pir', -fh => \*STDOUT);
83
 
 
84
 
while( $seq = $str->next_seq()) {
85
 
#    ok($seq->id, qr /^[PF]1/ );
86
 
    ok($seq->length > 1);
87
 
    $out->write_seq($seq) if $verbosity > 0;
88
 
}
89
 
$out = undef;
90
 
$ast = Bio::SeqIO->new( '-format' => 'GenBank' ,
91
 
'-file' => Bio::Root::IO->catfile("t","data","roa1.genbank"));
92
 
$ast->verbose($verbosity);
93
 
my $as = $ast->next_seq();
94
 
ok $as->molecule, 'mRNA';
95
 
ok $as->alphabet, 'dna';
96
 
ok($as->primary_id, 3598416);
97
 
 
98
 
 
99
 
$ast = Bio::SeqIO->new( '-format' => 'genbank' ,
100
 
'-file' => Bio::Root::IO->catfile("t","data",
101
 
  "NT_021877.gbk"));
102
 
$ast->verbose($verbosity);
103
 
$as = $ast->next_seq();
104
 
ok $as->molecule, 'DNA';
105
 
ok $as->alphabet, 'dna';
106
 
ok($as->primary_id, 37539616);
107
 
ok($as->accession_number, 'NT_021877');
108
 
 
109
 
my ($cds) = grep { $_->primary_tag eq 'CDS' } $as->get_SeqFeatures();
110
 
ok(($cds->get_tag_values('transl_except'))[1],
111
 
   '(pos:complement(4224..4226),aa:OTHER)');
112
 
# embl
113
 
$ast = Bio::SeqIO->new( '-format' => 'embl' ,
114
 
'-file' => Bio::Root::IO->catfile("t","data","roa1.dat"));
115
 
$ast->verbose($verbosity);
116
 
$as = $ast->next_seq();
117
 
ok defined $as->seq;
118
 
ok($as->display_id, 'HSHNCPA1');
119
 
ok($as->accession_number, 'X79536');
120
 
ok($as->seq_version, 1);
121
 
ok($as->version, 1);
122
 
ok($as->desc, 'H.sapiens mRNA for hnRNPcore protein A1');
123
 
ok($as->molecule, 'RNA');
124
 
ok($as->alphabet, 'rna');
125
 
ok(scalar $as->all_SeqFeatures(), 4);
126
 
ok($as->length, 1198);
127
 
ok($as->species->binomial(), 'Homo sapiens');
128
 
 
129
 
$ent = Bio::SeqIO->new( '-file' => Bio::Root::IO->catfile("t","data","test.embl"),
130
 
'-format' => 'embl');
131
 
 
132
 
$seq = $ent->next_seq();
133
 
 
134
 
ok(defined $seq->seq(), 1,
135
 
   'failure to read Embl with ^ location and badly split double quotes');
136
 
ok(scalar $seq->annotation->get_Annotations('reference'), 3);
137
 
 
138
 
$out = Bio::SeqIO->new('-file'=> ">embl.out",
139
 
       '-format' => 'embl');
140
 
 
141
 
ok($out->write_seq($seq),1,
142
 
   'failure to write Embl format with ^ < and > locations');
143
 
unlink("embl.out");
144
 
 
145
 
# kegg
146
 
my $kegg = Bio::SeqIO->new( '-format' => 'kegg' ,
147
 
    '-file' => Bio::Root::IO->catfile("t","data","AHCYL1.kegg"));
148
 
 
149
 
ok($kegg);
150
 
$kegg = $kegg->next_seq();
151
 
ok($kegg);
152
 
ok($kegg->accession, '10768');
153
 
ok($kegg->display_id, 'AHCYL1');
154
 
ok($kegg->alphabet, 'dna');
155
 
ok($kegg->seq);
156
 
ok($kegg->translate->seq);
157
 
ok(($kegg->annotation->get_Annotations('description'))[0]->text,
158
 
   'S-adenosylhomocysteine hydrolase-like 1 [EC:3.3.1.1]');
159
 
ok( (grep {$_->database eq 'KO'} 
160
 
     $kegg->annotation->get_Annotations('dblink'))[0]->comment, 
161
 
    'adenosylhomocysteinase' );
162
 
ok( (grep {$_->database eq 'PATH'} 
163
 
     $kegg->annotation->get_Annotations('dblink'))[0]->primary_id,
164
 
    'hsa00271' );
165
 
 
166
 
# multifile
167
 
$mf = Bio::SeqIO::MultiFile->new( '-format' => 'Fasta' ,
168
 
  '-files' =>
169
 
  [ Bio::Root::IO->catfile("t","data","multi_1.fa"),
170
 
    Bio::Root::IO->catfile("t","data","multi_2.fa")]);
171
 
 
172
 
ok defined $mf;
173
 
my $count = 0;
174
 
eval {
175
 
    while( $seq = $mf->next_seq() ) {
176
 
$count++;
177
 
$temp = $seq->display_id;
178
 
    }
179
 
};
180
 
ok( $count ,12);
181
 
$temp = undef;
182
 
 
183
 
# swissprot
184
 
$ast = Bio::SeqIO->new( '-verbosity' => $verbosity,
185
 
'-format' => 'swiss' ,
186
 
'-file' => Bio::Root::IO->catfile("t","data","roa1.swiss"));
187
 
$as = $ast->next_seq();
188
 
 
189
 
ok defined $as->seq;
190
 
ok($as->id, 'ROA1_HUMAN', "id is ".$as->id);
191
 
#ok($as->primary_id, 'ROA1');
192
 
skip($as->primary_id =~ /^Bio::Seq::/, $as->primary_id, 'ROA1');
193
 
ok($as->length, 371);
194
 
ok($as->alphabet, 'protein');
195
 
ok($as->division, 'HUMAN');
196
 
ok(scalar $as->all_SeqFeatures(), 16);
197
 
 
198
 
ok(scalar $as->annotation->get_Annotations('reference'), 11);
199
 
 
200
 
($ent, $seq, $out,$as) = undef;
201
 
 
202
 
 
203
 
 
204
 
 
205
 
#ace
206
 
{
207
 
    my $t_file = Bio::Root::IO->catfile("t","data","test.ace");
208
 
    my( $before );
209
 
    {
210
 
        local $/ = undef;
211
 
        local *BEFORE;
212
 
        open BEFORE, $t_file;
213
 
        $before = <BEFORE>;
214
 
        close BEFORE;
215
 
    }
216
 
 
217
 
    my $a_in = Bio::SeqIO->new( -FILE => $t_file, -FORMAT => 'ace');
218
 
    my( @a_seq );
219
 
    while (my $a = $a_in->next_seq) {
220
 
        push(@a_seq, $a);
221
 
    }
222
 
 
223
 
    ok @a_seq, 3, 'wrong number of sequence objects';
224
 
 
225
 
    my $esc_name = $a_seq[1]->display_id;
226
 
    ok( $esc_name , 'Name; 4% strewn with \ various / escaped characters',
227
 
"bad unescaping of characters, $esc_name");
228
 
 
229
 
    ok $a_seq[0]->alphabet, 'protein', 'alphabets incorrectly detected';
230
 
    ok $a_seq[1]->alphabet, 'dna', 'alphabets incorrectly detected';
231
 
 
232
 
    my $o_file = Bio::Root::IO->catfile("t","data","test.out.ace");
233
 
    my $a_out = Bio::SeqIO->new( -FILE => "> $o_file", -FORMAT => 'ace');
234
 
    my $a_out_ok = 1;
235
 
    foreach my $a (@a_seq) {
236
 
        $a_out->write_seq($a) or $a_out_ok = 0;
237
 
    }
238
 
    undef($a_out);  # Flush to disk
239
 
    ok $a_out_ok,1,'error writing sequence';
240
 
 
241
 
    my( $after );
242
 
    {
243
 
        local $/ = undef;
244
 
        local *AFTER;
245
 
        open AFTER, $o_file;
246
 
        $after = <AFTER>;
247
 
        close AFTER;
248
 
    }
249
 
    unlink($o_file);
250
 
 
251
 
    ok( ($before and $after and ($before eq $after)),1,
252
 
'test output file differs from input');
253
 
}
254
 
 
255
 
#
256
 
# streaming & Bio::RichSeq creation
257
 
#
258
 
 
259
 
my $stream = Bio::SeqIO->new('-file' => Bio::Root::IO->catfile("t","data","test.genbank"),
260
 
     '-format' => 'GenBank');
261
 
$stream->verbose($verbosity);
262
 
my $seqnum = 0;
263
 
my $species;
264
 
my @cl;
265
 
my $lasts;
266
 
my @ids = qw(DDU63596 DDU63595 HUMBDNF);
267
 
my @tids = (44689, 44689, 9606);
268
 
my @tnames = ("Dictyostelium discoideum","Dictyostelium discoideum","Homo sapiens");
269
 
while($seq = $stream->next_seq()) {
270
 
    if($seqnum < 3) {
271
 
ok $seq->display_id(), $ids[$seqnum];
272
 
$species = $seq->species();
273
 
@cl = $species->classification();
274
 
ok( $species->binomial(), $tnames[$seqnum],
275
 
    'species parsing incorrect for genbank');
276
 
ok( $cl[3] ne $species->genus(), 1,
277
 
    'genus duplicated in genbank parsing');
278
 
ok( $species->ncbi_taxid, $tids[$seqnum] );
279
 
    }
280
 
    $seqnum++;
281
 
    $lasts = $seq;
282
 
}
283
 
ok $lasts->display_id(), "HUMBETGLOA";
284
 
my ($ref) = $lasts->annotation->get_Annotations('reference');
285
 
ok($ref->medline, 94173918);
286
 
$stream->close();
287
 
 
288
 
$stream = Bio::SeqIO->new(
289
 
        '-file' => Bio::Root::IO->catfile("t","data","test.genbank.noseq"),
290
 
        '-format' => 'GenBank',
291
 
        );
292
 
$seqnum = 0;
293
 
while($seq = $stream->next_seq()) {
294
 
    if($seqnum < 3) {
295
 
        ok $seq->display_id(), $ids[$seqnum];
296
 
    } elsif( $seq->display_id eq 'M37762') {
297
 
ok( ($seq->get_keywords())[0], 'neurotrophic factor');
298
 
    }
299
 
    $seqnum++;
300
 
}
301
 
ok $seqnum, 5, "Total number of sequences in test file";
302
 
 
303
 
$ent = Bio::SeqIO->new( '-file' => Bio::Root::IO->catfile("t","data","test.embl"),
304
 
'-format' => 'embl');
305
 
$ent->verbose($verbosity);
306
 
$seq = $ent->next_seq();
307
 
$species = $seq->species();
308
 
@cl = $species->classification();
309
 
ok( $cl[3] ne $species->genus(), 1, 'genus duplicated in EMBL parsing');
310
 
$ent->close();
311
 
 
312
 
$seq = Bio::SeqIO->new( '-format' => 'GenBank' ,
313
 
-file => Bio::Root::IO->catfile("t","data","testfuzzy.genbank"));
314
 
$seq->verbose($verbosity);
315
 
ok(defined($as = $seq->next_seq()));
316
 
 
317
 
my @features = $as->all_SeqFeatures();
318
 
ok(@features,21);
319
 
my $lastfeature = pop @features;
320
 
 
321
 
# this is a split location; the root doesn't have strand
322
 
ok($lastfeature->strand, undef);
323
 
my $location = $lastfeature->location;
324
 
$location->verbose(-1); # silence the warning of undef seq_id()
325
 
# see above; splitlocs roots do not have a strand really
326
 
ok($location->strand, undef);
327
 
ok($location->start, 83202);
328
 
ok($location->end, 84996);
329
 
 
330
 
my @sublocs = $location->sub_Location();
331
 
 
332
 
ok(@sublocs, 2);
333
 
my $loc = shift @sublocs;
334
 
ok($loc->start, 83202);
335
 
ok($loc->end, 83329);
336
 
ok($loc->strand, -1);
337
 
 
338
 
$loc = shift @sublocs;
339
 
ok($loc->start, 84248);
340
 
ok($loc->end, 84996);
341
 
ok($loc->strand,1);
342
 
 
343
 
$seq = Bio::SeqIO->new( '-format' => 'GenBank' ,
344
 
-file => ">".Bio::Root::IO->catfile("t","data","genbank.fuzzyout"));
345
 
$seq->verbose($verbosity);
346
 
ok($seq->write_seq($as));
347
 
unlink(Bio::Root::IO->catfile("t","data","genbank.fuzzyout"));
348
 
 
349
 
my $seqio = Bio::SeqIO->new( '-format' => 'swiss' ,
350
 
  -file => Bio::Root::IO->catfile("t","data","swiss.dat"));
351
 
 
352
 
ok(defined( $seq = $seqio->next_seq));
353
 
 
354
 
# more tests to verify we are actually parsing correctly
355
 
skip($seq->primary_id =~ /^Bio::Seq/, $seq->primary_id, 'MA32');
356
 
ok($seq->display_id, 'MA32_HUMAN');
357
 
ok($seq->length, 282);
358
 
ok($seq->division, 'HUMAN');
359
 
ok($seq->alphabet, 'protein');
360
 
ok(scalar $seq->all_SeqFeatures(), 2);
361
 
 
362
 
my @genenames = qw(GC1QBP HABP1 SF2P32 C1QBP);
363
 
my ($ann) = $seq->annotation->get_Annotations('gene_name');
364
 
foreach my $gn ( $ann->get_all_values() ) {
365
 
    ok ($gn, shift(@genenames));
366
 
}
367
 
ok $ann->value(-joins => [" AND "," OR "]), "GC1QBP OR HABP1 OR SF2P32 OR C1QBP";
368
 
 
369
 
# test for feature locations like ?..N
370
 
ok(defined( $seq = $seqio->next_seq));
371
 
 
372
 
skip($seq->primary_id =~ /^Bio::Seq/, $seq->primary_id, 'ACON');
373
 
ok($seq->display_id, 'ACON_CAEEL');
374
 
ok($seq->length, 788);
375
 
ok($seq->division, 'CAEEL');
376
 
ok($seq->alphabet, 'protein');
377
 
ok(scalar $seq->all_SeqFeatures(), 5);
378
 
 
379
 
foreach my $gn ( $seq->annotation->get_Annotations('gene_name') ) {
380
 
    ok ($gn->value, 'F54H12.1');
381
 
}
382
 
 
383
 
 
384
 
# test species in swissprot -- this can be a n:n nightmare
385
 
ok ($seq = $seqio->next_seq());
386
 
my @sec_acc = $seq->get_secondary_accessions();
387
 
ok ($sec_acc[0], 'P29360');
388
 
ok ($sec_acc[1], 'Q63631');
389
 
ok ($seq->accession_number, 'P42655');
390
 
my @kw = $seq->get_keywords;
391
 
ok( $kw[0], 'Brain');
392
 
ok( $kw[1], 'Neurone');
393
 
ok ($kw[3], 'Multigene family');
394
 
ok ($seq->display_id, '143E_HUMAN');
395
 
ok ($seq->species->binomial, "Homo sapiens");
396
 
ok ($seq->species->common_name, "Human");
397
 
ok ($seq->species->ncbi_taxid, 9606);
398
 
 
399
 
ok ($seq = $seqio->next_seq());
400
 
ok ($seq->species->binomial, "Bos taurus");
401
 
ok ($seq->species->common_name, "Bovine");
402
 
ok ($seq->species->ncbi_taxid, 9913);
403
 
 
404
 
# multiple genes in swissprot
405
 
ok ($seq = $seqio->next_seq());
406
 
 
407
 
($ann) = $seq->annotation->get_Annotations("gene_name");
408
 
@genenames = qw(CALM1 CAM1 CALM CAM CALM2 CAM2 CAMB CALM3 CAM3 CAMC);
409
 
foreach my $gn ( $ann->get_all_values() ) {
410
 
    ok ($gn, shift(@genenames));
411
 
}
412
 
ok $ann->value(-joins => [" AND "," OR "]),
413
 
    "(CALM1 OR CAM1 OR CALM OR CAM) AND (CALM2 OR CAM2 OR CAMB) AND (CALM3 OR CAM3 OR CAMC)";
414
 
 
415
 
# test dos Linefeeds in gcg parser
416
 
$str = Bio::SeqIO->new('-file' => Bio::Root::IO->catfile("t","data","test_badlf.gcg"),
417
 
       '-format' => 'GCG');
418
 
 
419
 
ok($str);
420
 
ok ( $seq = $str->next_seq());
421
 
ok(length($seq->seq) > 0 );
422
 
print "Sequence 1 of 1 from GCG stream:\n", $seq->seq, "\n" if( $DEBUG);
423
 
 
424
 
 
425
 
$str  = new Bio::SeqIO(-format => 'genbank',
426
 
       -file   => Bio::Root::IO->catfile("t","data",
427
 
"AF165282.gb"),
428
 
       -verbose => $verbosity);
429
 
 
430
 
$seq = $str->next_seq;
431
 
@features = $seq->all_SeqFeatures();
432
 
ok(@features, 5);
433
 
ok($features[0]->start, 1);
434
 
ok($features[0]->end, 226);
435
 
$location = $features[1]->location;
436
 
ok($location->isa('Bio::Location::SplitLocationI'));
437
 
@sublocs = $location->sub_Location();
438
 
ok(@sublocs, 29);
439
 
 
440
 
# version and primary ID - believe it or not, this wasn't working
441
 
ok ($seq->version, 1);
442
 
ok ($seq->seq_version, 1);
443
 
ok ($seq->primary_id, "5734104");
444
 
 
445
 
 
446
 
# test embl writing of a PrimarySeq
447
 
 
448
 
my $primaryseq = new Bio::PrimarySeq( -seq => 'AGAGAGAGATA',
449
 
      -id  => 'myid',
450
 
      -desc => 'mydescr',
451
 
      -alphabet => 'DNA',
452
 
      -accession_number => 'myaccession');
453
 
 
454
 
my $embl = new Bio::SeqIO(-format => 'embl',
455
 
  -verbose => $verbosity,
456
 
  -file => ">primaryseq.embl");
457
 
 
458
 
ok($embl->write_seq($primaryseq));
459
 
my $scalar = "test";
460
 
eval {
461
 
    $embl->write_seq($scalar);
462
 
};
463
 
ok ($@);
464
 
 
465
 
unlink("primaryseq.embl");
466
 
 
467
 
 
468
 
# revcomp split location
469
 
my $gb = new Bio::SeqIO(-format => 'genbank',
470
 
    -file   => Bio::Root::IO->catfile(qw(t data revcomp_mrna.gb)));
471
 
 
472
 
$seq = $gb->next_seq();
473
 
 
474
 
$gb = new Bio::SeqIO(-format => 'genbank',
475
 
    -file   => ">tmp_revcomp_mrna.gb");
476
 
 
477
 
$gb->write_seq($seq);
478
 
undef $gb;
479
 
ok(! -z "tmp_revcomp_mrna.gb");
480
 
 
481
 
# INSERT DIFFING CODE HERE
482
 
 
483
 
unlink("tmp_revcomp_mrna.gb");
484
 
 
485
 
 
486
 
# test secondary accessions in EMBL (bug #1332)
487
 
 
488
 
$seqio = new Bio::SeqIO(-format =>'embl', -file => Bio::Root::IO->catfile
489
 
( qw(t data ECAPAH02.embl)));
490
 
$seq = $seqio->next_seq;
491
 
 
492
 
ok($seq->accession_number, 'D10483');
493
 
ok($seq->seq_version, 2);
494
 
my @accs = $seq->get_secondary_accessions();
495
 
ok($accs[0], 'J01597');
496
 
ok($accs[-1], 'X56742');
497
 
 
498
 
$seqio = new Bio::SeqIO(-format => 'genbank',
499
 
-file   => Bio::Root::IO->catfile(qw(t data
500
 
     D10483.gbk)));
501
 
 
502
 
$seq = $seqio->next_seq;
503
 
@kw =  $seq->get_keywords;
504
 
ok(scalar @kw, 118);
505
 
ok($kw[-1], 'yabO');
506
 
@sec_acc = $seq->get_secondary_accessions();
507
 
ok(scalar @sec_acc,14);
508
 
ok($sec_acc[-1], 'X56742');
509
 
 
510
 
 
511
 
### TPA TESTS - Thanks to Richard Adams ###
512
 
 
513
 
### test Third Party Annotation entries in EMBL/Gb format 
514
 
#   to ensure compatability with parsers. 
515
 
###embl####
516
 
 
517
 
$str = new Bio::SeqIO(-format =>'embl', -file => Bio::Root::IO->catfile
518
 
      ( qw(t data BN000066-tpa.embl)));
519
 
$seq = $str->next_seq;
520
 
ok(defined $seq);
521
 
ok($seq->accession_number, 'BN000066');
522
 
ok($seq->alphabet, 'dna');
523
 
ok($seq->display_id, 'AGA000066');
524
 
ok($seq->length, 5195);
525
 
ok($seq->division, 'INV');
526
 
ok($seq->get_dates, 2);
527
 
ok($seq->keywords, 'acetylcholinesterase; achE1 gene; Third Party Annotation; TPA.');
528
 
ok($seq->seq_version, 1);
529
 
ok($seq->feature_count, 15);
530
 
 
531
 
my $spec_obj = $seq->species;
532
 
ok ($spec_obj->common_name, 'African malaria mosquito');
533
 
ok ($spec_obj->species, 'gambiae');
534
 
ok ($spec_obj->genus, 'Anopheles');
535
 
ok ($spec_obj->binomial, 'Anopheles gambiae');
536
 
 
537
 
my $ac = $seq->annotation;
538
 
my $reference =  ($ac->get_Annotations('reference') )[1];
539
 
ok ($reference->title,'"A novel acetylcholinesterase gene in mosquitoes codes for the insecticide target and is non-homologous to the ace gene in Drosophila"');
540
 
ok ($reference->authors,'Weill M., Fort P., Berthomi eu A., Dubois M.P., Pasteur N., Raymond M.');
541
 
my $cmmnt =  ($ac->get_Annotations('comment') )[0];
542
 
ok($cmmnt->text, 'see also AJ488492 for achE-1 from Kisumu strain Third Party Annotation Database: This TPA record uses Anopheles gambiae trace archive data (http://trace.ensembl.org) ');
543
 
 
544
 
## now genbank ##
545
 
 
546
 
$str = new Bio::SeqIO(-format =>'genbank', -file => Bio::Root::IO->catfile
547
 
( qw(t data BK000016-tpa.gbk)));
548
 
$seq = $str->next_seq;
549
 
ok(defined $seq);
550
 
ok(defined $seq->seq);
551
 
ok($seq->accession_number, 'BK000016');
552
 
ok($seq->alphabet, 'dna');
553
 
ok($seq->display_id, 'BK000016');
554
 
ok($seq->length, 1162);
555
 
ok($seq->division, 'ROD');
556
 
ok($seq->get_dates, 1);
557
 
ok($seq->keywords, 'Third Party Annotation; TPA');
558
 
ok($seq->desc, 'TPA: Mus musculus pantothenate kinase 4 mRNA, partial cds.');
559
 
ok($seq->seq_version, 1);
560
 
ok($seq->feature_count, 2);
561
 
$spec_obj = $seq->species;
562
 
ok ($spec_obj->common_name, 'Mus musculus (house mouse)');
563
 
ok ($spec_obj->species, 'musculus');
564
 
ok ($spec_obj->genus, 'Mus');
565
 
ok ($spec_obj->binomial, 'Mus musculus');
566
 
$ac = $seq->annotation;
567
 
$reference =  ($ac->get_Annotations('reference') )[0];
568
 
ok ($reference->pubmed, '11479594');
569
 
ok ($reference->medline, '21372465');
570
 
 
571
 
# validate that what is written is what is read
572
 
 
573
 
my $testfile = "testtpa.gbk";
574
 
$out = new Bio::SeqIO(-file => ">$testfile",
575
 
      -format => 'genbank');
576
 
$out->write_seq($seq);
577
 
$out->close();
578
 
 
579
 
$str = new Bio::SeqIO(-format =>'genbank', 
580
 
      -file => $testfile);
581
 
$seq = $str->next_seq;
582
 
ok(defined $seq);
583
 
ok(defined $seq->seq);
584
 
ok($seq->accession_number, 'BK000016');
585
 
ok($seq->alphabet, 'dna');
586
 
ok($seq->display_id, 'BK000016');
587
 
ok($seq->length, 1162);
588
 
ok($seq->division, 'ROD');
589
 
ok($seq->get_dates, 1);
590
 
ok($seq->keywords, 'Third Party Annotation; TPA');
591
 
ok($seq->desc, 'TPA: Mus musculus pantothenate kinase 4 mRNA, partial cds.');
592
 
ok($seq->seq_version, 1);
593
 
ok($seq->feature_count, 2);
594
 
$spec_obj = $seq->species;
595
 
ok ($spec_obj->common_name, 'Mus musculus (house mouse)');
596
 
ok ($spec_obj->species, 'musculus');
597
 
ok ($spec_obj->genus, 'Mus');
598
 
ok ($spec_obj->binomial, 'Mus musculus');
599
 
$ac = $seq->annotation;
600
 
$reference =  ($ac->get_Annotations('reference') )[0];
601
 
ok ($reference->pubmed, '11479594');
602
 
ok ($reference->medline, '21372465');
603
 
 
604
 
unlink($testfile);
605
 
 
606
 
# bug #1487
607
 
 
608
 
$str = new Bio::SeqIO(-verbose => $verbosity,
609
 
      -file    => Bio::Root::IO->catfile
610
 
      (qw(t data D12555.gbk)));
611
 
eval { 
612
 
    $seq = $str->next_seq;    
613
 
};
614
 
 
615
 
ok(! $@ );
616
 
 
 
65
        map { unlink Bio::Root::IO->catfile("t","data","$_.out") } @formats
 
66
}