← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/bioperl/oneiric

« back to all changes in this revision

Viewing changes to t/TaxonTree.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2007-09-21 22:52:22 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070921225222-tt20m2yy6ycuy2d8
Tags: 1.5.2.102-1
* Developer release.
* Upgraded source package to debhelper 5 and standards-version 3.7.2.
* Added libmodule-build-perl and libtest-harness-perl to
  build-depends-indep.
* Disabled automatic CRAN download.
* Using quilt instead of .diff.gz to manage modifications.
* Updated Recommends list for the binary package.
* Moved the "production-quality" scripts to /usr/bin/.
* New maintainer: Debian-Med packaging team mailing list.
* New uploaders: Charles Plessy and Steffen Moeller.
* Updated Depends, Recommends and Suggests.
* Imported in Debian-Med's SVN repository on Alioth.
* Executing the regression tests during package building.
* Moved the Homepage: field out from the package's description.
* Updated watch file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/TaxonTree.t
 
1
# -*-Perl-*-
 
2
## Bioperl Test Harness Script for Modules
 
3
##
 
4
 
 
5
# These modules are now deprecated, don't bother testing them.
 
6
 
 
7
## I am pretty sure this module is going the way of the dodo bird so 
 
8
## I am not sure how much work to put into fixing the tests/module
 
9
## --jasonstajich
 
10
 
 
11
my $error;
 
12
use strict;
 
13
BEGIN { 
 
14
    # to handle systems with no installed Test module
 
15
    # we include the t dir (where a copy of Test.pm is located)
 
16
    # as a fallback
 
17
    $error = 0; 
 
18
    eval { require Test; };
 
19
    if( $@ ) {
 
20
        use lib 't';
 
21
    }
 
22
    use Test;
 
23
    plan tests => 1;
 
24
}
 
25
 
 
26
ok(1);
 
27
 
 
28
if (0) {
 
29
        use Bio::Taxonomy::Taxon;
 
30
        ok(1);
 
31
        
 
32
        
 
33
        ok my $taxonL = Bio::Taxonomy::Taxon->new;
 
34
        ok $taxonL->description('this could be anything');
 
35
        ok $taxonL->taxon('could this be called name?');
 
36
        ok $taxonL->id('could this be called taxid?');
 
37
        skip 1, $taxonL->branch_length('should accept only numerical values?');
 
38
        ok  $taxonL->branch_length(5);
 
39
        
 
40
        ok $taxonL->id('could this be called taxid?');
 
41
        ok $taxonL->rank('species');
 
42
        ok $taxonL->rank, 'species';
 
43
        # ok $taxonL->has_rank, 'species'; #why two methods that do mostly the same thing, but work differently?
 
44
        
 
45
        skip 1, $taxonL->rank('foo is not a rank, class variable @RANK not initialised'); 
 
46
        ok $taxonL->to_string, '"could this be called taxid?":5';
 
47
        
 
48
        my $taxonR = new Bio::Taxonomy::Taxon;
 
49
        
 
50
        my $taxon = new Bio::Taxonomy::Taxon(-id =>'ancient', -taxon => 'genus');
 
51
        ok $taxon->id(), 'ancient'; 
 
52
        ok $taxon->taxon(), 'genus'; 
 
53
        ok $taxon->internal_id, 2;
 
54
        ok $taxonL->internal_id, 0; # would not it be better to start numebering from 1?
 
55
        ok $taxon->add_Descendent($taxonL);
 
56
        $taxon->add_Descendent($taxonR);
 
57
        
 
58
        ok  scalar $taxon->each_Descendent, 2;  # dies
 
59
        ok $taxon->remove_Descendent($taxonR); # better to return number of Descendants removed
 
60
        
 
61
        ok $taxon->remove_all_Descendents();
 
62
        
 
63
        
 
64
        $taxon->add_Descendent($taxonL);
 
65
        ok $taxonL->ancestor->id, 'ancient';
 
66
        ok $taxonL->branch_length(5);
 
67
        
 
68
        
 
69
        ok $taxonL->is_Leaf, 1;
 
70
        ok $taxon->is_Leaf, 0;
 
71
        ok $taxon->height, 6;
 
72
        ok $taxonL->height, 5;
 
73
        ok $taxon->invalidate_height, undef;
 
74
        ok $taxonL->classify(1), 2;
 
75
        skip(1,"skip classify weirdness");
 
76
        # ok $taxonL->classify(0), 2, 'ancestor has rank, but implementation prevents showing anything more than one value';
 
77
        skip(1,"skip classify weirdness");
 
78
        #ok $taxonL->has_rank, 1, 'documentation claims this returns a boolean; and that it queries ancestors rank?, needs an agrument but does not test it';
 
79
        skip(1,"skip classify weirdness");
 
80
        #ok $taxonL->has_rank('species'), 1;
 
81
        
 
82
        #ok $taxon->has_taxon(); # why docs and code talk about ancestor?
 
83
        #ok $taxonL->has_taxon('genus');  returns undef or oan object, not boolean
 
84
        
 
85
        ok $taxon->distance_to_root, 0;
 
86
        ok $taxonL->distance_to_root, 1;
 
87
        #ok $taxonL->recent_common_ancestor($taxon)->id, 'ancient';
 
88
        
 
89
        
 
90
        
 
91
        #use Data::Dumper;
 
92
        #print Dumper  $taxonL->classify();
 
93
        skip(1, 'Skip this weird function');
 
94
        # ok $taxonL->has_rank('species'), 1;
 
95
        #ok my $species = $taxonL->species;
 
96
        
 
97
        
 
98
        
 
99
        
 
100
        
 
101
        ##################################################################################################
 
102
        
 
103
        # tests for Bio::Taxonomy::Tree;
 
104
        # code from synopsis
 
105
        
 
106
        use Bio::Species;
 
107
        use Bio::Taxonomy::Tree;
 
108
        use Bio::Taxonomy;
 
109
        
 
110
        my $human=new Bio::Species;
 
111
        my $chimp=new Bio::Species;
 
112
        my $bonobo=new Bio::Species;
 
113
        
 
114
        $human->classification(qw( sapiens Homo Hominidae
 
115
                                                           Catarrhini Primates Eutheria
 
116
                                                           Mammalia Euteleostomi Vertebrata 
 
117
                                                           Craniata Chordata
 
118
                                                           Metazoa Eukaryota ));
 
119
        $chimp->classification(qw( troglodytes Pan Hominidae
 
120
                                                           Catarrhini Primates Eutheria
 
121
                                                           Mammalia Euteleostomi Vertebrata 
 
122
                                                           Craniata Chordata
 
123
                                                           Metazoa Eukaryota ));
 
124
        $bonobo->classification(qw( paniscus Pan Hominidae
 
125
                                                                Catarrhini Primates Eutheria
 
126
                                                                Mammalia Euteleostomi Vertebrata 
 
127
                                                                Craniata Chordata
 
128
                                                                Metazoa Eukaryota ));
 
129
        
 
130
        # ranks passed to $taxonomy match ranks of species
 
131
        my @ranks = ('superkingdom','kingdom','phylum','subphylum',
 
132
                                 'no rank 1','no rank 2','class','no rank 3','order',
 
133
                                 'suborder','family','genus','species');
 
134
        
 
135
        my $taxonomy=new Bio::Taxonomy(-ranks => \@ranks,
 
136
                                                                   -method => 'trust',
 
137
                                                                   -order => -1);
 
138
        
 
139
        
 
140
        ok my $tree1=new Bio::Taxonomy::Tree;
 
141
        my $tree2=new Bio::Taxonomy::Tree;
 
142
        
 
143
        $tree1->make_species_branch($human,$taxonomy);
 
144
        $tree2->make_species_branch($chimp,$taxonomy);
 
145
        
 
146
        my ($homo_sapiens) = $tree1->get_leaves;
 
147
        ok ref $homo_sapiens, 'Bio::Taxonomy::Taxon';
 
148
        
 
149
        ok $tree1->splice($tree2);
 
150
        
 
151
        ok $tree1->add_species($bonobo,$taxonomy);
 
152
        
 
153
        
 
154
        ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Homo sapiens, Pan troglodytes, Pan paniscus';
 
155
        ok $tree1->remove_branch($homo_sapiens);
 
156
        ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Pan troglodytes, Pan paniscus';
 
157
}