~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to t/LocalDB/DBFasta.t

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# -*-Perl-*- Test Harness script for Bioperl
2
 
# $Id$
3
 
 
4
 
 
5
 
BEGIN {     
6
 
    use lib '.';
7
 
        use Bio::Root::Test;
8
 
        
9
 
    test_begin(-tests => 17,
10
 
               -requires_modules => [qw(Bio::DB::Fasta Bio::SeqIO)]);
11
 
}
12
 
use strict;
13
 
use warnings;
14
 
use Bio::Root::Root;
15
 
use File::Copy;
16
 
my $DEBUG = test_debug();
17
 
 
18
 
{
19
 
 
20
 
my $test_dbdir = setup_temp_dir('dbfa');
21
 
 
22
 
# now use this temporary dir for the db file
23
 
my $db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1);
24
 
ok($db);
25
 
cmp_ok($db->length('CEESC13F'), '>', 0);
26
 
is(length $db->seq('CEESC13F:1,10'), 10);
27
 
is(length $db->seq('AW057119',1,10), 10);
28
 
my $primary_seq = $db->get_Seq_by_id('AW057119');
29
 
ok($primary_seq);
30
 
cmp_ok(length($primary_seq->seq), '>', 0);
31
 
is($primary_seq->trunc(1,10)->length, 10);
32
 
is($primary_seq->description, 'test description', 'bug 3126');
33
 
ok(!defined $db->get_Seq_by_id('foobarbaz'));
34
 
undef $db;
35
 
undef $primary_seq;
36
 
 
37
 
my (%h,$dna1,$dna2);
38
 
ok(tie(%h,'Bio::DB::Fasta',$test_dbdir));
39
 
ok($h{'AW057146'});
40
 
ok($dna1 = $h{'AW057146:1,10'});
41
 
ok($dna2 = $h{'AW057146:10,1'});
42
 
 
43
 
my $revcom = reverse $dna1;
44
 
$revcom =~ tr/gatcGATC/ctagCTAG/;
45
 
is($dna2, $revcom);
46
 
 
47
 
# test out writing the Bio::PrimarySeq::Fasta objects with SeqIO
48
 
 
49
 
$db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1);
50
 
my $out = Bio::SeqIO->new(-format => 'genbank',
51
 
              -file  => '>'.test_output_file());
52
 
$primary_seq = Bio::Seq->new(-primary_seq => $db->get_Seq_by_acc('AW057119'));
53
 
eval {
54
 
    #warn(ref($primary_seq),"\n");
55
 
    $out->write_seq($primary_seq) 
56
 
};
57
 
ok(!$@);
58
 
 
59
 
$out = Bio::SeqIO->new(-format => 'embl', -file  => '>'.test_output_file());
60
 
 
61
 
eval {
62
 
    $out->write_seq($primary_seq) 
63
 
};
64
 
ok(!$@);
65
 
 
66
 
# Issue 3172
67
 
 
68
 
{
69
 
    # squash warnings locally
70
 
    local $SIG{__WARN__} = sub {};
71
 
    $test_dbdir = setup_temp_dir('bad_dbfa');
72
 
    throws_ok {$db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1)}
73
 
        qr/FASTA header doesn't match/;
74
 
}
75
 
 
76
 
exit;
77
 
 
78
 
}
79
 
 
80
 
sub setup_temp_dir {
81
 
    # this obfuscation is to deal with lockfiles by GDBM_File which can
82
 
    # only be created on local filesystems apparently so will cause test
83
 
    # to block and then fail when the testdir is on an NFS mounted system
84
 
    
85
 
    my $data_dir = shift;
86
 
    
87
 
    my $io = Bio::Root::IO->new();
88
 
    my $tempdir = test_output_dir();
89
 
    my $test_dbdir = $io->catfile($tempdir, $data_dir);
90
 
    mkdir($test_dbdir); # make the directory
91
 
    my $indir = test_input_file($data_dir);
92
 
    opendir(my $INDIR,$indir) || die("cannot open dir $indir");
93
 
    # effectively do a cp -r but only copy the files that are in there, no subdirs
94
 
    for my $file ( map { $io->catfile($indir,$_) } readdir($INDIR) ) {
95
 
        next unless (-f $file );
96
 
        copy($file, $test_dbdir);
97
 
    }
98
 
    closedir($INDIR);
99
 
    return $test_dbdir
100
 
}
101