1 # -*-Perl-*- Test Harness script for Bioperl
10 eval { require Test::Memory::Cycle; 1; };
12 eval { require Test::Weaken; 1; };
14 test_begin(-tests => 27);
16 use_ok('Bio::Species');
17 use_ok('Bio::DB::Taxonomy');
20 ok my $sps = Bio::Species->new();
21 $sps->classification(qw( sapiens Homo Hominidae
22 Catarrhini Primates Eutheria Mammalia Vertebrata
23 Chordata Metazoa Eukaryota));
25 is $sps->binomial, 'Homo sapiens';
27 ok $sps->sub_species('sapiensis');
28 is $sps->binomial, 'Homo sapiens';
29 is $sps->binomial('FULL'), 'Homo sapiens sapiensis';
30 is $sps->sub_species, 'sapiensis';
32 $sps->classification(qw( sapiens Homo Hominidae
33 Catarrhini Primates Eutheria Mammalia Vertebrata
34 Chordata Metazoa Eukaryota));
35 is $sps->binomial, 'Homo sapiens';
38 # test cmd line initializtion
39 ok my $species = Bio::Species->new( -classification =>
40 [ qw( sapiens Homo Hominidae
41 Catarrhini Primates Eutheria
43 Chordata Metazoa Eukaryota) ],
44 -common_name => 'human');
45 is $species->binomial, 'Homo sapiens';
46 is $species->species, 'sapiens';
47 is $species->genus, 'Homo';
48 # test -common_name parameter, bug 2549
49 is $species->common_name, 'human';
51 # A Bio::Species isa Bio::Taxon, so test some things from there briefly
52 is $species->scientific_name, 'sapiens';
53 is $species->rank, 'species';
55 # We can make a species object from just an id an db handle
57 test_skip(-tests => 5, -requires_networking => 1);
59 $species = Bio::Species->new(-id => 51351);
60 my $taxdb = Bio::DB::Taxonomy->new(-source => 'entrez');
61 eval {$species->db_handle($taxdb);};
62 skip "Unable to connect to entrez database; no network or server busy?", 5 if $@;
63 is $species->binomial, 'Brassica rapa subsp.';
64 is $species->binomial('FULL'), 'Brassica rapa subsp. pekinensis';
65 is $species->genus, 'Brassica';
66 is $species->species, 'rapa subsp.';
67 is $species->sub_species, 'pekinensis';
71 skip("Test::Memory::Cycle not installed, skipping", 2) if !$CYCLE;
72 # this sub leaks, should return true
73 my ($a, $b); $a = \$b; $b = \$a;
74 Test::Memory::Cycle::memory_cycle_exists($a);
75 # this sub shouldn't leak (no circ. refs)
76 $species = Bio::Species->new( -classification =>
77 [ qw( sapiens Homo Hominidae
78 Catarrhini Primates Eutheria
80 Chordata Metazoa Eukaryota) ],
81 -common_name => 'human');
82 Test::Memory::Cycle::memory_cycle_exists($species);
85 Test::Memory::Cycle::memory_cycle_exists(Bio::Species->new(-classification => ['A']));
89 skip("Test::Weaken not installed, skipping", 2) if !$WEAKEN;
91 # this sub leaks, should return true
92 ok(Test::Weaken::leaks({
93 constructor => sub { my ($a, $b); $a = \$b; $b = \$a}
96 # this sub shouldn't leak (no circ. refs)
97 ok(!Test::Weaken::leaks({
98 constructor => sub{ Bio::Species->new( -classification =>
99 [ qw( sapiens Homo Hominidae
100 Catarrhini Primates Eutheria
102 Chordata Metazoa Eukaryota) ],
103 -common_name => 'human') },
108 ok(!Test::Weaken::leaks({
109 constructor => sub{ Bio::Species->new( -classification => ['A']) },