t/SeqFeature/RangeI.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 45);
  11
  12     use_ok('Bio::SeqFeature::Generic');
  13 }
  14
  15 my @funcs = qw(start end length strand overlaps contains
  16     equals intersection union overlap_extent disconnected_ranges
  17     offsetStranded subtract);
  18
  19 my $i = 1;
  20 while (my $func = shift @funcs ) {
  21     $i++;
  22
  23     # test for presence of method
  24     ok exists $Bio::RangeI::{$func};
  25
  26     # union get caught in an infinite loop w/o parameters; skip invoke test.
  27     next if $func eq 'union';
  28
  29     # call to strand complains without a value; skip invoke test.
  30     next if $func eq 'disconnected_ranges';
  31
  32     # test invocation of method
  33     eval { $Bio::RangeI::{$func}->(); };
  34     ok($@);
  35 }
  36
  37 ### unit tests for subtract method ###
  38 # contributed by Stephen Montgomery (sm8 at sanger.ac.uk), who also
  39 # wrote the subtract method
  40 my $feature1 =  Bio::SeqFeature::Generic->new( -start => 1, -end =>
  41 1000, -strand => 1);
  42 my $feature2 =  Bio::SeqFeature::Generic->new( -start => 100, -end =>
  43 900, -strand => -1);
  44
  45 my $subtracted = $feature1->subtract($feature2);
  46 ok(defined($subtracted));
  47 is(scalar(@$subtracted), 2);
  48 foreach my $range (@$subtracted) {
  49     ok($range->start == 1 || $range->start == 901);
  50     ok($range->end == 99 || $range->end == 1000);
  51 }
  52
  53 $subtracted = $feature2->subtract($feature1);
  54 ok(!defined($subtracted));
  55 $subtracted = $feature1->subtract($feature2, 'weak');
  56 ok(!defined($subtracted));
  57 $subtracted = $feature1->subtract($feature2, 'strong');
  58 ok(!defined($subtracted));
  59
  60 my $feature3 =  Bio::SeqFeature::Generic->new( -start => 500, -end =>
  61 1500, -strand => 1);
  62 $subtracted = $feature1->subtract($feature3);
  63 ok(defined($subtracted));
  64 is scalar(@$subtracted), 1;
  65 my $subtracted_i = @$subtracted[0];
  66 is($subtracted_i->start, 1);
  67 is($subtracted_i->end, 499);
  68
  69
  70 # ---------------
  71 # Added Bio::Location::SplitLocationI support to subtract().  --jhannah 20091018
  72 $feature1 =  Bio::SeqFeature::Generic->new();
  73 $feature2 =  Bio::SeqFeature::Generic->new();
  74 my $loc = Bio::Location::Split->new();
  75 $loc->add_sub_Location(Bio::Location::Simple->new(-start=>100, -end=>200, -strand=>1));
  76 $loc->add_sub_Location(Bio::Location::Simple->new(-start=>300, -end=>400, -strand=>1));
  77 $loc->add_sub_Location(Bio::Location::Simple->new(-start=>500, -end=>600, -strand=>1));
  78 $feature1->location($loc);
  79 $loc = Bio::Location::Split->new();
  80 $loc->add_sub_Location(Bio::Location::Simple->new(-start=>350, -end=>400, -strand=>1));
  81 $loc->add_sub_Location(Bio::Location::Simple->new(-start=>500, -end=>510, -strand=>1));
  82 $feature2->location($loc);
  83 $subtracted = $feature1->subtract($feature2);
  84 is(@$subtracted, 3,                              "subtract() of split features");
  85 is($subtracted->[0]->start, 100,                 "   0 start");
  86 is($subtracted->[0]->end,   200,                 "   0 end");
  87 is($subtracted->[1]->start, 300,                 "   1 start");
  88 is($subtracted->[1]->end,   349,                 "   1 end");
  89 is($subtracted->[2]->start, 511,                 "   2 start");
  90 is($subtracted->[2]->end,   600,                 "   2 end");
  91 # ---------------
  92
  93