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