t/LocationFactory.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 => 275;
  19 }
  20
  21 use_ok('Bio::Factory::FTLocationFactory');
  22 use_ok('Bio::Factory::LocationFactoryI');
  23 use_ok('Bio::Location::Simple');
  24 use_ok('Bio::Location::Split');
  25 use_ok('Bio::Location::Fuzzy');
  26
  27 my $simple_impl = "Bio::Location::Simple";
  28 my $fuzzy_impl = "Bio::Location::Fuzzy";
  29 my $split_impl = "Bio::Location::Split";
  30
  31 # Holds strings and results. The latter is an array of expected class name,
  32 # min/max start position and position type, min/max end position and position
  33 # type, location type, the number of locations, and the strand.
  34 #
  35 my %testcases = (
  36    # note: the following are directly taken from
  37    # http://www.ncbi.nlm.nih.gov/collab/FT/#location
  38    "467" => [$simple_impl,
  39             467, 467, "EXACT", 467, 467, "EXACT", "EXACT", 1, 1],
  40         "340..565" => [$simple_impl,
  41                  340, 340, "EXACT", 565, 565, "EXACT", "EXACT", 1, 1],
  42         "<345..500" => [$fuzzy_impl,
  43                  undef, 345, "BEFORE", 500, 500, "EXACT", "EXACT", 1, 1],
  44         "<1..888" => [$fuzzy_impl,
  45                  undef, 1, "BEFORE", 888, 888, "EXACT", "EXACT", 1, 1],
  46         "(102.110)" => [$fuzzy_impl,
  47                  102, 102, "EXACT", 110, 110, "EXACT", "WITHIN", 1, 1],
  48         "(23.45)..600" => [$fuzzy_impl,
  49                  23, 45, "WITHIN", 600, 600, "EXACT", "EXACT", 1, 1],
  50         "(122.133)..(204.221)" => [$fuzzy_impl,
  51                  122, 133, "WITHIN", 204, 221, "WITHIN", "EXACT", 1, 1],
  52         "123^124" => [$simple_impl,
  53                  123, 123, "EXACT", 124, 124, "EXACT", "IN-BETWEEN", 1, 1],
  54         "145^177" => [$fuzzy_impl,
  55                  145, 145, "EXACT", 177, 177, "EXACT", "IN-BETWEEN", 1, 1],
  56         "join(12..78,134..202)" => [$split_impl,
  57                  12, 12, "EXACT", 202, 202, "EXACT", "EXACT", 2, 1],
  58         "complement(join(4918..5163,2691..4571))" => [$split_impl,
  59                  2691, 2691, "EXACT", 5163, 5163, "EXACT", "EXACT", 2, -1],
  60         "complement(34..(122.126))" => [$fuzzy_impl,
  61                  34, 34, "EXACT", 122, 126, "WITHIN", "EXACT", 1, -1],
  62         "J00194:100..202" => [$simple_impl,
  63                  100, 100, "EXACT", 202, 202, "EXACT", "EXACT", 1, 1],
  64         # this variant is not really allowed by the FT definition
  65         # document but we want to be able to cope with it
  66         "J00194:(100..202)" => [$simple_impl,
  67                  100, 100, "EXACT", 202, 202, "EXACT", "EXACT", 1, 1],
  68         "((122.133)..(204.221))" => [$fuzzy_impl,
  69                  122, 133, "WITHIN", 204, 221, "WITHIN", "EXACT", 1, 1],
  70         "join(AY016290.1:108..185,AY016291.1:1546..1599)"=> [$split_impl,
  71                  108, 108, "EXACT", 185, 185, "EXACT", "EXACT", 2, undef],
  72
  73         # UNCERTAIN locations and positions (Swissprot)
  74    "?2465..2774" => [$fuzzy_impl,
  75        2465, 2465, "UNCERTAIN", 2774, 2774, "EXACT", "EXACT", 1, 1],
  76    "22..?64" => [$fuzzy_impl,
  77        22, 22, "EXACT", 64, 64, "UNCERTAIN", "EXACT", 1, 1],
  78    "?22..?64" => [$fuzzy_impl,
  79        22, 22, "UNCERTAIN", 64, 64, "UNCERTAIN", "EXACT", 1, 1],
  80    "?..>393" => [$fuzzy_impl,
  81        undef, undef, "UNCERTAIN", 393, undef, "AFTER", "UNCERTAIN", 1, 1],
  82    "<1..?" => [$fuzzy_impl,
  83        undef, 1, "BEFORE", undef, undef, "UNCERTAIN", "UNCERTAIN", 1, 1],
  84    "?..536" => [$fuzzy_impl,
  85        undef, undef, "UNCERTAIN", 536, 536, "EXACT", "UNCERTAIN", 1, 1],
  86    "1..?" => [$fuzzy_impl,
  87        1, 1, "EXACT", undef, undef, "UNCERTAIN", "UNCERTAIN", 1, 1],
  88    "?..?" => [$fuzzy_impl,
  89        undef, undef, "UNCERTAIN", undef, undef, "UNCERTAIN", "UNCERTAIN", 1, 1],
  90    # Not working yet:
  91    #"12..?1" => [$fuzzy_impl,
  92    #    1, 1, "UNCERTAIN", 12, 12, "EXACT", "EXACT", 1, 1]
  93                  );
  94
  95 my $locfac = Bio::Factory::FTLocationFactory->new();
  96 isa_ok($locfac,'Bio::Factory::LocationFactoryI');
  97
  98 # sorting is to keep the order constant from one run to the next
  99 foreach my $locstr (keys %testcases) {
 100         my $loc = $locfac->from_string($locstr);
 101         if($locstr eq "join(AY016290.1:108..185,AY016291.1:1546..1599)") {
 102                 $loc->seq_id("AY016295.1");
 103         }
 104         my @res = @{$testcases{$locstr}};
 105         is(ref($loc), $res[0], $res[0]);
 106         is($loc->min_start(), $res[1]);
 107         is($loc->max_start(), $res[2]);
 108         is($loc->start_pos_type(), $res[3]);
 109         is($loc->min_end(), $res[4]);
 110         is($loc->max_end(), $res[5]);
 111         is($loc->end_pos_type(), $res[6]);
 112         is($loc->location_type(), $res[7]);
 113         my @locs = $loc->each_Location();
 114         is(@locs, $res[8]);
 115         my $ftstr = $loc->to_FTstring();
 116         # this is a somewhat ugly hack, but we want clean output from to_FTstring()
 117         # Umm, then these should really fail, correct?
 118         # Should we be engineering workarounds for tests?
 119         $locstr = "J00194:100..202" if $locstr eq "J00194:(100..202)";
 120         $locstr = "(122.133)..(204.221)" if $locstr eq "((122.133)..(204.221))";
 121         # now test
 122         is($ftstr, $locstr, "Location String: $locstr");
 123         # test strand production
 124         is($loc->strand(), $res[9]);
 125 }
 126
 127 if ($^V gt v5.6.0) {
 128         # bug #1674, #1765, 2101
 129         # EMBL-like
 130         # join(20464..20694,21548..22763,join(complement(314652..314672),complement(232596..232990),complement(231520..231669)))
 131         # GenBank-like
 132         # join(20464..20694,21548..22763,complement(join(231520..231669,232596..232990,314652..314672)))
 133         # Note that
 134         # join(1000..2000,join(3000..4000,join(5000..6000,7000..8000)),9000..10000)
 135         # is the same as
 136         # join(1000..2000,3000..4000,5000..6000,7000..8000,9000..10000)
 137         # But I don't want to bother with it at this point
 138         my @expected = (# intentionally testing same expected string twice
 139                                         # as I am providing two different encodings
 140                                         # that should mean the same thing
 141         'join(11025..11049,complement(join(315036..315294,251354..251412,241499..241580,239890..240081)))',
 142         'join(11025..11049,complement(join(315036..315294,251354..251412,241499..241580,239890..240081)))',
 143         # ditto
 144         'join(20464..20694,21548..22763,complement(join(314652..314672,232596..232990,231520..231669)))',
 145         'join(20464..20694,21548..22763,complement(join(314652..314672,232596..232990,231520..231669)))',
 146         # this is just seen once
 147         'join(1000..2000,join(3000..4000,join(5000..6000,7000..8000)),9000..10000)'
 148    );
 149
 150         for my $locstr (
 151                 'join(11025..11049,join(complement(239890..240081),complement(241499..241580),complement(251354..251412),complement(315036..315294)))',
 152                 'join(11025..11049,complement(join(315036..315294,251354..251412,241499..241580,239890..240081)))',
 153                 'join(20464..20694,21548..22763,complement(join(314652..314672,232596..232990,231520..231669)))',
 154                 'join(20464..20694,21548..22763,join(complement(231520..231669),complement(232596..232990),complement(314652..314672)))',
 155                 'join(1000..2000,join(3000..4000,join(5000..6000,7000..8000)),9000..10000)'
 156            ) {
 157                 my $loc = $locfac->from_string($locstr);
 158                 my $ftstr = $loc->to_FTstring();
 159                 is($ftstr, shift @expected, $locstr);
 160         }
 161 } else {
 162         foreach (1..3) {
 163                 skip('nested matches in regex only supported in v5.6.1 and higher',1);
 164         }
 165 }