t/Location.t

   1 # -*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3 ## $Id$
   4
   5 # Before `make install' is performed this script should be runnable with
   6 # `make test'. After `make install' it should work as `perl test.t'
   7
   8 use strict;
   9 BEGIN {
  10     # to handle systems with no installed Test module
  11     # we include the t dir (where a copy of Test.pm is located)
  12     # as a fallback
  13     eval { require Test::More; };
  14     if( $@ ) {
  15                 use lib 't/lib';
  16     }
  17     use Test::More;
  18     plan tests => 104;
  19 }
  20
  21 use_ok('Bio::Location::Simple');
  22 use_ok('Bio::Location::Split');
  23 use_ok('Bio::Location::Fuzzy');
  24
  25 use_ok('Bio::SeqFeature::Generic');
  26 use_ok('Bio::SeqFeature::SimilarityPair');
  27 use_ok('Bio::SeqFeature::FeaturePair');
  28
  29 ok(1);
  30
  31 my $simple = new Bio::Location::Simple('-start' => 10, '-end' => 20,
  32                                        '-strand' => 1, -seq_id => 'my1');
  33 isa_ok($simple, 'Bio::LocationI');
  34 isa_ok($simple, 'Bio::RangeI');
  35
  36 is($simple->start, 10, 'Bio::Location::Simple tests');
  37 is($simple->end, 20);
  38 is($simple->seq_id, 'my1');
  39
  40 my ($loc) = $simple->each_Location();
  41 ok($loc);
  42 is("$loc", "$simple");
  43
  44 my $generic = new Bio::SeqFeature::Generic('-start' => 5, '-end' => 30,
  45                                            '-strand' => 1);
  46
  47 isa_ok($generic,'Bio::SeqFeatureI', 'Bio::SeqFeature::Generic' );
  48 isa_ok($generic,'Bio::RangeI');
  49 is($generic->start, 5);
  50 is($generic->end, 30);
  51
  52 my $similarity = new Bio::SeqFeature::SimilarityPair();
  53
  54 my $feat1 = new Bio::SeqFeature::Generic('-start' => 30, '-end' => 43,
  55                                          '-strand' => -1);
  56 my $feat2 = new Bio::SeqFeature::Generic('-start' => 80, '-end' => 90,
  57                                          '-strand' => -1);
  58
  59 my $featpair = new Bio::SeqFeature::FeaturePair('-feature1' => $feat1,
  60                                                 '-feature2' => $feat2 );
  61
  62 my $feat3 = new Bio::SeqFeature::Generic('-start' => 35, '-end' => 50,
  63                                          '-strand' => -1);
  64
  65 is($featpair->start, 30,'Bio::SeqFeature::FeaturePair tests');
  66 is($featpair->end,  43);
  67
  68 is($featpair->length, 14);
  69
  70 ok($featpair->overlaps($feat3));
  71 ok($generic->overlaps($simple), 'Bio::SeqFeature::Generic tests');
  72 ok($generic->contains($simple));
  73
  74 # fuzzy location tests
  75 my $fuzzy = new Bio::Location::Fuzzy('-start'  =>'<10',
  76                                      '-end'    => 20,
  77                                      -strand   =>1,
  78                                      -seq_id   =>'my2');
  79
  80 is($fuzzy->strand, 1, 'Bio::Location::Fuzzy tests');
  81 is($fuzzy->start, 10);
  82 is($fuzzy->end,20);
  83 ok(!defined $fuzzy->min_start);
  84 is($fuzzy->max_start, 10);
  85 is($fuzzy->min_end, 20);
  86 is($fuzzy->max_end, 20);
  87 is($fuzzy->location_type, 'EXACT');
  88 is($fuzzy->start_pos_type, 'BEFORE');
  89 is($fuzzy->end_pos_type, 'EXACT');
  90 is($fuzzy->seq_id, 'my2');
  91 is($fuzzy->seq_id('my3'), 'my3');
  92
  93 ($loc) = $fuzzy->each_Location();
  94 ok($loc);
  95 is("$loc", "$fuzzy");
  96
  97 # split location tests
  98 my $splitlocation = new Bio::Location::Split;
  99 my $f = new Bio::Location::Simple(-start  => 13,
 100                                   -end    => 30,
 101                                   -strand => 1);
 102 $splitlocation->add_sub_Location($f);
 103 is($f->start, 13, 'Bio::Location::Split tests');
 104 is($f->min_start, 13);
 105 is($f->max_start,13);
 106
 107
 108 $f = new Bio::Location::Simple(-start  =>30,
 109                                -end    =>90,
 110                                -strand =>1);
 111 $splitlocation->add_sub_Location($f);
 112
 113 $f = new Bio::Location::Simple(-start  =>18,
 114                                -end    =>22,
 115                                -strand =>1);
 116 $splitlocation->add_sub_Location($f);
 117
 118 $f = new Bio::Location::Simple(-start  =>19,
 119                                -end    =>20,
 120                                -strand =>1);
 121
 122 $splitlocation->add_sub_Location($f);
 123
 124 $f = new Bio::Location::Fuzzy(-start  =>"<50",
 125                               -end    =>61,
 126                               -strand =>1);
 127 is($f->start, 50);
 128 ok(! defined $f->min_start);
 129 is($f->max_start, 50);
 130
 131 is(scalar($splitlocation->each_Location()), 4);
 132
 133 $splitlocation->add_sub_Location($f);
 134
 135 is($splitlocation->max_end, 90);
 136 is($splitlocation->min_start, 13);
 137 is($splitlocation->end, 90);
 138 is($splitlocation->start, 13);
 139 is($splitlocation->sub_Location(),5);
 140
 141
 142 is($fuzzy->to_FTstring(), '<10..20');
 143 $fuzzy->strand(-1);
 144 is($fuzzy->to_FTstring(), 'complement(<10..20)');
 145 is($simple->to_FTstring(), '10..20');
 146 $simple->strand(-1);
 147 is($simple->to_FTstring(), 'complement(10..20)');
 148 is( $splitlocation->to_FTstring(),
 149     'join(13..30,30..90,18..22,19..20,<50..61)');
 150
 151 # test for bug #1074
 152 $f = new Bio::Location::Simple(-start  => 5,
 153                                -end    => 12,
 154                                -strand => -1);
 155 $splitlocation->add_sub_Location($f);
 156 is( $splitlocation->to_FTstring(),
 157     'join(13..30,30..90,18..22,19..20,<50..61,complement(5..12))',
 158         'Bugfix 1074');
 159 $splitlocation->strand(-1);
 160 is( $splitlocation->to_FTstring(),
 161     'complement(join(13..30,30..90,18..22,19..20,<50..61,5..12))');
 162
 163 $f = new Bio::Location::Fuzzy(-start => '45.60',
 164                               -end   => '75^80');
 165
 166 is($f->to_FTstring(), '(45.60)..(75^80)');
 167 $f->start('20>');
 168 is($f->to_FTstring(), '>20..(75^80)');
 169
 170 # test that even when end < start that length is always positive
 171
 172 $f = new Bio::Location::Simple(-verbose => -1,
 173                                -start   => 100,
 174                                -end     => 20,
 175                                -strand  => 1);
 176
 177 is($f->length, 81, 'Positive length');
 178 is($f->strand,-1);
 179
 180 # test that can call seq_id() on a split location;
 181 $splitlocation = new Bio::Location::Split(-seq_id => 'mysplit1');
 182 is($splitlocation->seq_id,'mysplit1', 'seq_id() on Bio::Location::Split');
 183 is($splitlocation->seq_id('mysplit2'),'mysplit2');
 184
 185
 186 # Test Bio::Location::Exact
 187
 188 ok(my $exact = new Bio::Location::Simple(-start    => 10,
 189                                          -end      => 20,
 190                                          -strand   => 1,
 191                                          -seq_id   => 'my1'));
 192 isa_ok($exact, 'Bio::LocationI');
 193 isa_ok($exact, 'Bio::RangeI');
 194
 195 is( $exact->start, 10, 'Bio::Location::Simple EXACT');
 196 is( $exact->end, 20);
 197 is( $exact->seq_id, 'my1');
 198 is( $exact->length, 11);
 199 is( $exact->location_type, 'EXACT');
 200
 201 ok ($exact = new Bio::Location::Simple(-start         => 10,
 202                                       -end           => 11,
 203                                       -location_type => 'IN-BETWEEN',
 204                                       -strand        => 1,
 205                                       -seq_id        => 'my2'));
 206
 207 is($exact->start, 10, 'Bio::Location::Simple IN-BETWEEN');
 208 is($exact->end, 11);
 209 is($exact->seq_id, 'my2');
 210 is($exact->length, 0);
 211 is($exact->location_type, 'IN-BETWEEN');
 212
 213 eval {
 214     $exact = new Bio::Location::Simple(-start         => 10,
 215                                        -end           => 12,
 216                                        -location_type => 'IN-BETWEEN');
 217 };
 218 ok( $@, 'Testing error handling' );
 219
 220 # testing error when assigning 10^11 simple location into fuzzy
 221 eval {
 222     ok $fuzzy = new Bio::Location::Fuzzy(-start         => 10,
 223                                          -end           => 11,
 224                                          -location_type => '^',
 225                                          -strand        => 1,
 226                                          -seq_id        => 'my2');
 227 };
 228 ok( $@ );
 229
 230 $fuzzy = new Bio::Location::Fuzzy(-location_type => '^',
 231                                   -strand        => 1,
 232                                   -seq_id        => 'my2');
 233
 234 $fuzzy->start(10);
 235 eval { $fuzzy->end(11) };
 236 ok($@);
 237
 238 $fuzzy = new Bio::Location::Fuzzy(-location_type => '^',
 239                                   -strand        => 1,
 240                                   -seq_id        =>'my2');
 241
 242 $fuzzy->end(11);
 243 eval {
 244     $fuzzy->start(10);
 245 };
 246 ok($@);
 247
 248 # testing coodinate policy modules
 249
 250 use_ok('Bio::Location::WidestCoordPolicy');
 251 use_ok('Bio::Location::NarrowestCoordPolicy');
 252 use_ok('Bio::Location::AvWithinCoordPolicy');
 253
 254 $f = new Bio::Location::Fuzzy(-start => '40.60',
 255                               -end   => '80.100');
 256 is $f->start, 40, 'Default coodinate policy';
 257 is $f->end, 100;
 258 is $f->length, 61;
 259 is $f->to_FTstring, '(40.60)..(80.100)';
 260 isa_ok($f->coordinate_policy, 'Bio::Location::WidestCoordPolicy');
 261
 262 # this gives an odd location string; is it legal?
 263 $f->coordinate_policy(new Bio::Location::NarrowestCoordPolicy);
 264 is $f->start, 60, 'Narrowest coodinate policy';
 265 is $f->end, 80;
 266 is $f->length, 21;
 267 is $f->to_FTstring, '(60.60)..(80.80)';
 268 isa_ok($f->coordinate_policy, 'Bio::Location::NarrowestCoordPolicy');
 269
 270 # this gives an odd location string
 271 $f->coordinate_policy(new Bio::Location::AvWithinCoordPolicy);
 272 is $f->start, 50, 'Average coodinate policy';
 273 is $f->end, 90;
 274 is $f->length, 41;
 275 is $f->to_FTstring, '(50.60)..(80.90)';
 276 isa_ok($f->coordinate_policy, 'Bio::Location::AvWithinCoordPolicy');
 277
 278 # to complete the circle
 279 $f->coordinate_policy(new Bio::Location::WidestCoordPolicy);
 280 is $f->start, 40, 'Widest coodinate policy';
 281 is $f->end, 100;
 282 is $f->length, 61;
 283 is $f->to_FTstring, '(40.60)..(80.100)';
 284 isa_ok($f->coordinate_policy, 'Bio::Location::WidestCoordPolicy');
 285