Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 30 additions & 0 deletions t/AnnotationI.t
Original file line number Diff line number Diff line change
@@ -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');

31 changes: 31 additions & 0 deletions t/SeqI.t
Original file line number Diff line number Diff line change
@@ -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');

25 changes: 25 additions & 0 deletions t/Species/basic.t
Original file line number Diff line number Diff line change
@@ -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';

57 changes: 57 additions & 0 deletions t/Species/memory.t
Original file line number Diff line number Diff line change
@@ -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");
}

25 changes: 25 additions & 0 deletions t/Species/taxonomy_db.t
Original file line number Diff line number Diff line change
@@ -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';