diff --git a/t/AnnotationI.t b/t/AnnotationI.t new file mode 100644 index 000000000..c680ea291 --- /dev/null +++ b/t/AnnotationI.t @@ -0,0 +1,30 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Test::More tests => 4; + +BEGIN { + use_ok('Bio::AnnotationI'); +} + +{ + package MyAnnotation; + use base qw(Bio::AnnotationI); + + sub new { + my $class = shift; + return bless {}, $class; + } + + sub tagname { return "mock_tag"; } + sub as_text { return "Mock annotation as text"; } + sub hash_tree { return {}; } +} + +my $a = MyAnnotation->new(); + +isa_ok($a, 'Bio::AnnotationI'); +is($a->tagname, 'mock_tag', 'tagname returns expected value'); +is($a->as_text, 'Mock annotation as text', 'as_text returns expected value'); + diff --git a/t/SeqI.t b/t/SeqI.t new file mode 100644 index 000000000..d56358c70 --- /dev/null +++ b/t/SeqI.t @@ -0,0 +1,31 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Test::More tests => 4; + +BEGIN { + use_ok('Bio::SeqI'); +} + +{ + package MySeq; + use base qw(Bio::SeqI); + + sub new { + my $class = shift; + return bless {}, $class; + } + + sub display_id { return "test_id"; } + sub seq { return "ATGC"; } + sub desc { return "Test sequence"; } + sub alphabet { return "dna"; } +} + +my $seq = MySeq->new(); + +isa_ok($seq, 'Bio::SeqI'); +is($seq->display_id, 'test_id', 'display_id returns correct value'); +is($seq->seq, 'ATGC', 'seq returns correct sequence'); + diff --git a/t/Species/basic.t b/t/Species/basic.t new file mode 100644 index 000000000..b1ba014da --- /dev/null +++ b/t/Species/basic.t @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 8; + +use_ok('Bio::Species'); + +my $sps = Bio::Species->new(); +$sps->classification([qw(sapiens Homo Hominidae Catarrhini Primates Eutheria Mammalia Vertebrata Chordata Metazoa Eukaryota)]); + +is $sps->binomial, 'Homo sapiens'; + +$sps->sub_species('sapiensis'); +is $sps->binomial, 'Homo sapiens'; +is $sps->binomial('FULL'), 'Homo sapiens sapiensis'; + +is $sps->sub_species, 'sapiensis'; + +my $species = Bio::Species->new( + -classification => [qw(sapiens Homo Hominidae Catarrhini Primates Eutheria Mammalia Vertebrata Chordata Metazoa Eukaryota)], + -common_name => 'human' +); +is $species->binomial, 'Homo sapiens'; +is $species->genus, 'Homo'; + diff --git a/t/Species/memory.t b/t/Species/memory.t new file mode 100644 index 000000000..75f7fe0e4 --- /dev/null +++ b/t/Species/memory.t @@ -0,0 +1,57 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Bio::Root::Test; +use Bio::Species; + +eval { require Test::Memory::Cycle; 1; }; +my $CYCLE = $@ ? 0 : 1; +eval { require Test::Weaken; 1; }; +my $WEAKEN = $@ ? 0 : 1; + +test_begin(-tests => 6); + +SKIP: { + skip("Test::Memory::Cycle not installed", 3) if !$CYCLE; + + # Intentional circular ref (should leak) + my ($a, $b); $a = \$b; $b = \$a; + ok(Test::Memory::Cycle::memory_cycle_exists($a), "Intentional circular reference leaks"); + + # Bio::Species should not leak + my $species = Bio::Species->new( + -classification => [qw(sapiens Homo)], + -common_name => 'human' + ); + ok(!Test::Memory::Cycle::memory_cycle_exists($species), "Bio::Species does not leak"); + + # GitHub issue #81 regression + ok(!Test::Memory::Cycle::memory_cycle_exists(Bio::Species->new(-classification => ['A'])), "Regression test for #81"); +} + +SKIP: { + skip("Test::Weaken not installed", 3) if !$WEAKEN; + + # Deliberate leak + ok(Test::Weaken::leaks({ + constructor => sub { my ($a, $b); $a = \$b; $b = \$a; } + }), "Deliberate circular ref detected by Test::Weaken"); + + # Bio::Species should not leak + ok(!Test::Weaken::leaks({ + constructor => sub { + Bio::Species->new( + -classification => [qw(sapiens Homo)], + -common_name => 'human' + ) + } + }), "Bio::Species passes Test::Weaken"); + + # Regression test for #81 + ok(!Test::Weaken::leaks({ + constructor => sub { Bio::Species->new(-classification => ['A']) } + }), "Regression check for #81 via Test::Weaken"); +} + diff --git a/t/Species/taxonomy_db.t b/t/Species/taxonomy_db.t new file mode 100644 index 000000000..e0e5eddd3 --- /dev/null +++ b/t/Species/taxonomy_db.t @@ -0,0 +1,25 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Bio::Root::Test; +use Bio::Species; +use Bio::DB::Taxonomy; + +test_begin(-tests => 5, + -requires_module => 'Bio::DB::Taxonomy::entrez', + -requires_networking => 1); + +my $species = Bio::Species->new(-id => 51351); +my $taxdb = Bio::DB::Taxonomy->new(-source => 'entrez'); + +eval { $species->db_handle($taxdb); }; +skip("Unable to connect to Entrez database; no network or server busy?", 5) if $@; + +is $species->binomial, 'Brassica rapa subsp.'; +is $species->binomial('FULL'), 'Brassica rapa subsp. pekinensis'; +is $species->genus, 'Brassica'; +is $species->species, 'rapa subsp.'; +is $species->sub_species, 'pekinensis'; +