t/Species.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2
   3 use strict;
   4 my $CYCLE;
   5 my $WEAKEN;
   6
   7 BEGIN {
   8     use lib '.';
   9     use Bio::Root::Test;
  10     eval { require Test::Memory::Cycle; 1; };
  11     $CYCLE = $@ ? 0 : 1;
  12     eval { require Test::Weaken; 1; };
  13     $WEAKEN = $@ ? 0 : 1;
  14     test_begin(-tests => 27);
  15
  16         use_ok('Bio::Species');
  17         use_ok('Bio::DB::Taxonomy');
  18 }
  19
  20 ok my $sps = Bio::Species->new();
  21 $sps->classification(qw( sapiens Homo Hominidae
  22              Catarrhini Primates Eutheria Mammalia Vertebrata
  23              Chordata Metazoa Eukaryota));
  24
  25 is $sps->binomial, 'Homo sapiens';
  26
  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';
  31
  32 $sps->classification(qw( sapiens Homo Hominidae
  33              Catarrhini Primates Eutheria Mammalia Vertebrata
  34              Chordata Metazoa Eukaryota));
  35 is $sps->binomial, 'Homo sapiens';
  36
  37
  38 # test cmd line initializtion
  39 ok my $species = Bio::Species->new( -classification =>
  40                 [ qw( sapiens Homo Hominidae
  41                       Catarrhini Primates Eutheria
  42                       Mammalia Vertebrata
  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';
  50
  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';
  54
  55 # We can make a species object from just an id an db handle
  56 SKIP: {
  57     test_skip(-tests => 5,
  58               -requires_module     => 'LWP::UserAgent',
  59               -requires_networking => 1);
  60
  61     $species = Bio::Species->new(-id => 51351);
  62     my $taxdb = Bio::DB::Taxonomy->new(-source => 'entrez');
  63     eval {$species->db_handle($taxdb);};
  64     skip "Unable to connect to entrez database; no network or server busy?", 5 if $@;
  65     is $species->binomial, 'Brassica rapa subsp.';
  66     is $species->binomial('FULL'), 'Brassica rapa subsp. pekinensis';
  67     is $species->genus, 'Brassica';
  68     is $species->species, 'rapa subsp.';
  69     is $species->sub_species, 'pekinensis';
  70 }
  71
  72 SKIP: {
  73     skip("Test::Memory::Cycle not installed, skipping", 3) if !$CYCLE;
  74     # this sub leaks, should return true
  75     my ($a, $b); $a = \$b; $b = \$a;
  76     Test::Memory::Cycle::memory_cycle_exists($a);
  77     # this sub shouldn't leak (no circ. refs)
  78     $species = Bio::Species->new( -classification =>
  79                 [ qw( sapiens Homo Hominidae
  80                       Catarrhini Primates Eutheria
  81                       Mammalia Vertebrata
  82                       Chordata Metazoa Eukaryota) ],
  83                 -common_name => 'human');
  84     Test::Memory::Cycle::memory_cycle_exists($species);
  85
  86     # Github issue #81
  87     Test::Memory::Cycle::memory_cycle_exists(Bio::Species->new(-classification => ['A']));
  88 }
  89
  90 SKIP: {
  91     skip("Test::Weaken not installed, skipping", 3) if !$WEAKEN;
  92
  93     # this sub leaks, should return true
  94     ok(Test::Weaken::leaks({
  95         constructor => sub { my ($a, $b); $a = \$b; $b = \$a}
  96     }));
  97
  98     # this sub shouldn't leak (no circ. refs)
  99     ok(!Test::Weaken::leaks({
 100       constructor => sub{ Bio::Species->new( -classification =>
 101                                 [ qw( sapiens Homo Hominidae
 102                                       Catarrhini Primates Eutheria
 103                                       Mammalia Vertebrata
 104                                       Chordata Metazoa Eukaryota) ],
 105                                 -common_name => 'human') },
 106       }
 107     ));
 108
 109     # Github issue #81
 110     ok(!Test::Weaken::leaks({
 111       constructor => sub{ Bio::Species->new( -classification => ['A']) },
 112       }
 113     ));
 114 }