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

« back to all changes in this revision

Viewing changes to t/DBCUTG.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
# This is -*-Perl-*- code
2
2
## Bioperl Test Harness Script for Modules
3
3
##
4
 
# $Id: DBCUTG.t,v 1.8 2003/12/18 03:03:26 jason Exp $ 
5
 
 
 
4
# $Id: DBCUTG.t,v 1.20.4.5 2006/11/17 09:32:42 sendu Exp $ 
6
5
# Before `make install' is performed this script should be runnable with
7
6
# `make test'. After `make install' it should work as `perl test.t'
 
7
 
8
8
use strict;
9
 
use vars qw($NUMTESTS $DEBUG $ERROR);
 
9
use vars qw($NUMTESTS $DEBUG);
10
10
 
11
 
$DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
12
11
BEGIN {
13
 
    # to handle systems with no installed Test module
14
 
    # we include the t dir (where a copy of Test.pm is located)
15
 
    # as a fallback
16
 
    eval { require Test; };
17
 
    $ERROR = 0;
18
 
    if( $@ ) {
19
 
        use lib 't';
20
 
    }
21
 
    use Test;
22
 
 
23
 
    $NUMTESTS = 22;
24
 
    plan tests => $NUMTESTS;
25
 
 
26
 
    eval {
27
 
        require IO::String; 
28
 
        require LWP::UserAgent;
29
 
    }; 
30
 
    if( $@ ) {
31
 
        warn("IO::String or LWP::UserAgent not installed. This means that the module is not usable. Skipping tests");
32
 
        $ERROR = 1;
33
 
    }
 
12
        $NUMTESTS = 35;
 
13
        $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
 
14
        
 
15
        eval {require Test::More;};
 
16
        if ($@) {
 
17
                use lib 't/lib';
 
18
        }
 
19
        use Test::More;
 
20
        
 
21
        eval {
 
22
                require IO::String; 
 
23
                require LWP::UserAgent;
 
24
        };
 
25
        if ($@) {
 
26
                plan skip_all => 'IO::String or LWP::UserAgent not installed. This means that the module is not usable. Skipping tests';
 
27
        }
 
28
        else {
 
29
                plan tests => $NUMTESTS;
 
30
        }
 
31
        
 
32
        use_ok('Bio::DB::CUTG');
 
33
        use_ok('Bio::CodonUsage::Table');
 
34
        use_ok('Bio::CodonUsage::IO');
 
35
    use_ok('Bio::SeqIO');
 
36
    use_ok('Bio::Tools::SeqStats');
 
37
        use_ok('Bio::Root::IO');
34
38
}
35
39
 
36
40
END {
37
 
    foreach ( $Test::ntest..$NUMTESTS) {
38
 
        skip('unable to run all of the tests depending on web access',1);
39
 
    }
40
 
}
41
 
 
42
 
exit 0 if $ERROR ==  1;
43
 
 
44
 
use Data::Dumper;
45
 
require Bio::DB::CUTG;
46
 
require Bio::CodonUsage::Table;
47
 
require Bio::CodonUsage::IO;
48
 
require Bio::SeqIO;
49
 
require Bio::Tools::SeqStats;
50
 
ok 1;
51
 
 
52
 
my $verbose = 0;
53
 
$verbose = 1 if $DEBUG;
54
 
 
55
 
ok my $tool = Bio::WebAgent->new(-verbose =>$verbose);
56
 
if( $DEBUG ) { 
57
 
    ok $tool->sleep;
58
 
    ok $tool->delay(1), 1;
59
 
    ok $tool->sleep;
60
 
 
61
 
#get CUT from web
62
 
    ok my $db = Bio::DB::CUTG->new();
63
 
    my $cdtable =  $db->get_request(-sp =>'Pan troglodytes');
64
 
    exit unless $cdtable;
65
 
#tests for Table.pm
66
 
    ok $cdtable->cds_count(), 401;
67
 
    ok int($cdtable->aa_frequency('LEU')), 9;
68
 
    ok $cdtable->get_coding_gc('all');
69
 
    ok $cdtable->codon_rel_frequency('ttc'), "0.68"; 
70
 
    
71
 
#now try reading from file
72
 
    ok my $io = Bio::CodonUsage::IO->new
73
 
        (-file=> Bio::Root::IO->catfile("t", "data", "MmCT"));
74
 
    ok  my $cut2 = $io->next_data();
75
 
    ok int($cut2->aa_frequency('LEU')), 10;
76
 
    
77
 
#now try making a user defined CUT from a sequence
78
 
    
79
 
    ok my $seqobj = Bio::SeqIO->new (-file=>
80
 
                                     Bio::Root::IO->catfile("t", "data", 
81
 
                                                            "HUMBETGLOA.fa"),
82
 
                                     -format => 'fasta')->next_seq;
83
 
    ok $seqobj->subseq(10,20), 'TTGACACCACT';
84
 
    ok my $codcont_Ref = Bio::Tools::SeqStats->count_codons($seqobj);
85
 
    ok $codcont_Ref->{'TGA'}, 16;
86
 
    ok my $cut = Bio::CodonUsage::Table->new(-data=>$codcont_Ref);
87
 
    ok $cut->codon_rel_frequency('CTG'), 0.18;
88
 
    ok $cut->codon_abs_frequency('CTG'), 2.6;
89
 
    ok $cut->codon_count('CTG'), 26;
90
 
    ok $cut->get_coding_gc(1), "39.70";
91
 
} else { 
92
 
   for ( $Test::ntest..$NUMTESTS) {
93
 
        skip("Skipping tests which require remote servers - set env variable BIOPERLDEBUG to test",1);
94
 
    }
95
 
}
96
 
 
97
 
 
98
 
 
 
41
        unlink(Bio::Root::IO->catfile("t","data","cutg.out"));
 
42
}
 
43
 
 
44
my $outfile = Bio::Root::IO->catfile("t","data","cutg.out");
 
45
my $verbose = 1 if $DEBUG;
 
46
 
 
47
# try reading from file
 
48
ok my $io = Bio::CodonUsage::IO->new
 
49
  (-file=> Bio::Root::IO->catfile("t", "data", "MmCT"));
 
50
ok  my $cut2 = $io->next_data();
 
51
is int($cut2->aa_frequency('LEU')), 10;
 
52
 
 
53
# write
 
54
ok $io = Bio::CodonUsage::IO->new(-file => ">$outfile");
 
55
$io->write_data($cut2);
 
56
ok -e $outfile;
 
57
 
 
58
# can we read what we've written?
 
59
ok $io = Bio::CodonUsage::IO->new(-file => "$outfile");
 
60
ok $cut2 = $io->next_data();
 
61
is int($cut2->aa_frequency('LEU')), 10;
 
62
 
 
63
# now try making a user defined CUT from a sequence
 
64
ok my $seqobj = Bio::SeqIO->new (-file =>
 
65
                         Bio::Root::IO->catfile("t", "data", "HUMBETGLOA.fa"),
 
66
                                                        -format => 'fasta')->next_seq;
 
67
is $seqobj->subseq(10,20), 'TTGACACCACT';
 
68
ok my $codcont_Ref = Bio::Tools::SeqStats->count_codons($seqobj);
 
69
is $codcont_Ref->{'TGA'}, 16;
 
70
ok my $cut = Bio::CodonUsage::Table->new(-data=>$codcont_Ref);
 
71
is $cut->codon_rel_frequency('CTG'), 0.18;
 
72
is $cut->codon_abs_frequency('CTG'), 2.6;
 
73
is $cut->codon_count('CTG'), 26;
 
74
is $cut->get_coding_gc(1), "39.70";
 
75
ok my $ref = $cut->probable_codons(20);
 
76
 
 
77
# requiring Internet access, set env BIOPERLDEBUG to 1 to run
 
78
SKIP: {
 
79
        skip "Skipping tests which require remote servers, set BIOPERLDEBUG=1 to test", 11 unless $DEBUG;
 
80
        ok my $tool = Bio::WebAgent->new(-verbose =>$verbose);
 
81
        ok $tool->sleep;
 
82
        is $tool->delay(1), 1;
 
83
        ok $tool->sleep;
 
84
 
 
85
        # get CUT from web
 
86
        ok my $db = Bio::DB::CUTG->new();
 
87
        ok $db->verbose(1);
 
88
        my $cdtable;
 
89
        eval {$cdtable = $db->get_request(-sp =>'Pan troglodytes');};
 
90
        skip "Could not connect to server, server/network problems? Skipping those tests", 5 if $@;
 
91
        
 
92
        # tests for Table.pm, the answers seem to change with time, so not specific
 
93
        cmp_ok($cdtable->cds_count(), '>', 600);
 
94
        cmp_ok(int($cdtable->aa_frequency('LEU')), '>', 1);
 
95
        ok $cdtable->get_coding_gc('all');
 
96
        cmp_ok($cdtable->codon_rel_frequency('ttc'), '<', 1); 
 
97
    
 
98
        ## now lets enter a non-existent species ans check handling..
 
99
        ## should default to human...
 
100
        my $db2 = Bio::DB::CUTG->new();
 
101
        eval {$cut2 = $db2->get_request(-sp =>'Wookie magnus');};
 
102
        skip "Could not connect to server, server/network problems? Skipping those tests", 1 if $@;
 
103
        is $cut2->species(), 'Homo sapiens';
 
104
}