t/Location.t

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