Allow falling back to any strigified Bio::AnnotationI for 'gene_name'
[bioperl-live.git] / t / Ontology / IO / interpro.t
blob6303689d3725f33bff76cde6feea97ebb2afe02a
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id$
4 use strict;
6 BEGIN {
7         use lib '.';
8     use Bio::Root::Test;
9     
10     test_begin(-tests => 69,
11                            -requires_modules => [qw(XML::Parser::PerlSAX
12                                                                             XML::Parser
13                                                                                 Graph::Directed)]);
14         
15         use_ok('Bio::OntologyIO');
17 use Data::Dumper;
19 my $ipp = Bio::OntologyIO->new( -format => 'interpro',
20                                                                                   -file => test_input_file('interpro_short.xml'),
21                                                                                   -ontology_engine => 'simple' );
22 isa_ok ($ipp, 'Bio::OntologyIO::InterProParser');
24 my $ip;
25 while(my $ont = $ipp->next_ontology()) {
26     # there should be only one ontology
27     is ($ip, undef);
28     $ip = $ont;
30 # we grep for defined values because we don't want a list of undefined values to be pass any test
31 my @leaves = $ip->get_leaf_terms;
32 ok( ( grep { defined } map { $_->get_dbxrefs } @leaves), 'get_dbxrefs on leaf terms is non-empty');
33 ok( ( grep { defined } map { $_->get_dbxrefs('member_list') } @leaves), 'get_dbxrefs(member_list) on leaf terms is non-empty');
34 ok( ( grep { defined } map { $_->get_dbxrefs('sec_list') } @leaves),    'get_dbxrefs(sec_list) on leaf terms is non-empty');
35 ok( ( grep { defined } map { $_->get_dbxrefs('class_list') } @leaves),  'get_dbxrefs(class_list) on leaf terms is non-empty');
36 ok( ( grep { defined } map { $_->get_dbxrefs('pub_list') } @leaves),    'get_dbxrefs(pub_list) on leaf terms is non-empty');
37 ok( ( grep { defined } map { $_->get_dbxrefs('example_list') } @leaves),'get_dbxrefs(example_list) on leaf terms is non-empty');
38 ok( ( grep { defined } map { $_->get_dbxrefs('external_doc_list') } @leaves), 'get_dbxrefs(external_doc_list) on leaf terms is non-empty');
40 ok( ( grep { defined } map { $_->get_members } @leaves), 'get_members on leaf terms is non-empty');
41 ok( ( grep { defined } map { $_->class_list } @leaves), 'class_list on leaf terms is non-empty');
42 ok( ( grep { defined } map { $_->get_examples } @leaves), 'get_examples on leaf terms is non-empty');
43 ok( ( grep { defined } map { $_->get_external_documents } @leaves), 'get_external_documents on leaf terms is non-empty');
44 ok( ( grep { defined } map { $_->get_references } @leaves), 'get_references on leaf terms is non-empty');
45 ok( ( grep { defined } map { $_->protein_count } @leaves), 'protein_count on leaf terms is non-empty');
47 # this could greatly be improved
48 like( $leaves[0]->to_string, qr/-- InterPro id:/, 'to_string looks reasonable');
51 # there should be 8 root terms: InterPro Domain, InterPro Family,
52 # InterPro Repeat, and InterPro PTM (Post Translational Modification),
53 # Active_site, Binding_site, Conserved_site and Region
55 my @rt = sort { $a->name cmp $b->name; } $ip->get_root_terms();
56 is (scalar(@rt), 8, 'There are 8 root InterPro terms');
58 # every InterPro term should have an ontology,
59 foreach ($ip->get_leaf_terms, @rt) {
60         isa_ok ($_->ontology, 'Bio::Ontology::Ontology');
61         is ($_->ontology->name, "InterPro",
62                  "term ".$_->name." in ontology InterPro");
65 # there are 10 fully instantiated InterPro terms in total, which should be returned as the leafs
66 is (scalar($ip->get_leaf_terms()), 10);
67 # roots and leafs together:
68 is (scalar($ip->get_all_terms()), 15);
70 # descendants and children (synonymous here because of depth 1)
71 # note that the sort should have placed Domain first and Family second
72 is (scalar($ip->get_descendant_terms($rt[3])), 4); # 4 InterPro Domains
73 is (scalar($ip->get_child_terms($rt[3])), 4);      # dto.
74 is (scalar($ip->get_descendant_terms($rt[4])), 3); # 3 Interpro Family
75 is (scalar($ip->get_child_terms($rt[4])), 3);      # dto.
77 # test for ancestors and parents (synonymous here because of depth 1)
78 foreach my $t ($ip->get_leaf_terms) {
79         # every InterPro term has exactly one parent - namely either 
80         # Domain, Region, Family, Repeat, or PTM(Post Transl. Modification)
82         if (!($t->identifier eq "Repeat" || $t->identifier eq "PTM" || $t->identifier eq "Region"
83                         || $t->identifier =~ '_site' )) {
84                 is (scalar($ip->get_parent_terms($t)), 1, $t->name . " term has one parent");
85                 is (scalar($ip->get_ancestor_terms($t)), 1, $t->name . " term has one ancestor");
86         }
89 # test for secondary accession map
90 is(scalar(keys %{$ipp->secondary_accessions_map}), 2, 'secondary accession map has 2 keys');