# -*-Perl-*- Test Harness script for Bioperl

use strict;
my $CYCLE;
my $WEAKEN;

BEGIN {
    use lib '.';
    use Bio::Root::Test;
    eval { require Test::Memory::Cycle; 1; };
    $CYCLE = $@ ? 0 : 1;
    eval { require Test::Weaken; 1; };
    $WEAKEN = $@ ? 0 : 1;
    test_begin(-tests => 27);
        
        use_ok('Bio::Species');
        use_ok('Bio::DB::Taxonomy');
}

ok my $sps = Bio::Species->new();
$sps->classification(qw( sapiens Homo Hominidae
             Catarrhini Primates Eutheria Mammalia Vertebrata
             Chordata Metazoa Eukaryota));

is $sps->binomial, 'Homo sapiens';

ok $sps->sub_species('sapiensis');
is $sps->binomial, 'Homo sapiens';
is $sps->binomial('FULL'), 'Homo sapiens sapiensis';
is $sps->sub_species, 'sapiensis';

$sps->classification(qw( sapiens Homo Hominidae
             Catarrhini Primates Eutheria Mammalia Vertebrata
             Chordata Metazoa Eukaryota));
is $sps->binomial, 'Homo sapiens';


# test cmd line initializtion
ok 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->species, 'sapiens';
is $species->genus, 'Homo';
# test -common_name parameter, bug 2549
is $species->common_name, 'human';

# A Bio::Species isa Bio::Taxon, so test some things from there briefly
is $species->scientific_name, 'sapiens';
is $species->rank, 'species';

# We can make a species object from just an id an db handle
SKIP: {
    test_skip(-tests => 5,
              -requires_module     => 'LWP::UserAgent',
              -requires_networking => 1);
    
    $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';
}

SKIP: {
    skip("Test::Memory::Cycle not installed, skipping", 3) if !$CYCLE;
    # this sub leaks, should return true
    my ($a, $b); $a = \$b; $b = \$a;
    Test::Memory::Cycle::memory_cycle_exists($a);
    # this sub shouldn't leak (no circ. refs)
    $species = Bio::Species->new( -classification => 
                [ qw( sapiens Homo Hominidae
                      Catarrhini Primates Eutheria 
                      Mammalia Vertebrata
                      Chordata Metazoa Eukaryota) ],
                -common_name => 'human');
    Test::Memory::Cycle::memory_cycle_exists($species);
    
    # Github issue #81
    Test::Memory::Cycle::memory_cycle_exists(Bio::Species->new(-classification => ['A']));
}

SKIP: {
    skip("Test::Weaken not installed, skipping", 3) if !$WEAKEN;
    
    # this sub leaks, should return true
    ok(Test::Weaken::leaks({
        constructor => sub { my ($a, $b); $a = \$b; $b = \$a}
    }));
    
    # this sub shouldn't leak (no circ. refs)
    ok(!Test::Weaken::leaks({
      constructor => sub{ Bio::Species->new( -classification => 
				[ qw( sapiens Homo Hominidae
				      Catarrhini Primates Eutheria 
				      Mammalia Vertebrata
				      Chordata Metazoa Eukaryota) ],
				-common_name => 'human') },
      }
    ));
    
    # Github issue #81    
    ok(!Test::Weaken::leaks({
      constructor => sub{ Bio::Species->new( -classification => ['A']) },
      }
    ));
}
