1 # -*-Perl-*- Test Harness script for Bioperl
10 test_begin(-tests => 307);
12 use_ok('Bio::Factory::FTLocationFactory');
15 my $simple_impl = "Bio::Location::Simple";
16 my $fuzzy_impl = "Bio::Location::Fuzzy";
17 my $split_impl = "Bio::Location::Split";
19 # Holds strings and results. The latter is an array of expected class name,
20 # min/max start position and position type, min/max end position and position
21 # type, location type, the number of locations, and the strand.
24 # note: the following are directly taken from
25 # http://www.insdc.org/documents/feature_table.html#3.4.3
27 => [$simple_impl, 467, 467, "EXACT",
31 => [$simple_impl, 340, 340, "EXACT",
35 => [$fuzzy_impl, undef, 345, "BEFORE",
39 => [$fuzzy_impl, undef, 1, "BEFORE",
43 => [$fuzzy_impl, 1, 1, "EXACT",
47 => [$fuzzy_impl, 102, 102, "EXACT",
51 => [$fuzzy_impl, 23, 45, "WITHIN",
54 "(122.133)..(204.221)"
55 => [$fuzzy_impl, 122, 133, "WITHIN",
59 => [$simple_impl, 123, 123, "EXACT",
63 => [$fuzzy_impl, 145, 145, "EXACT",
66 "join(12..78,134..202)"
67 => [$split_impl, 12, 12, "EXACT",
70 "complement(join(2691..4571,4918..5163))"
71 => [$split_impl, 2691, 2691, "EXACT",
74 "complement(34..(122.126))"
75 => [$fuzzy_impl, 34, 34, "EXACT",
79 => [$simple_impl, 100, 100, "EXACT",
82 "join(1..100,J00194.1:100..202)"
83 => [$split_impl, 1, 1, "EXACT",
87 # this variant is not really allowed by the FT definition
88 # document but we want to be able to cope with it
90 => [$simple_impl, 100, 100, "EXACT",
93 "((122.133)..(204.221))"
94 => [$fuzzy_impl, 122, 133, "WITHIN",
97 "join(AY016290.1:108..185,AY016291.1:1546..1599)"
98 => [$split_impl, 108, 108, "EXACT",
102 # UNCERTAIN locations and positions (Swissprot)
104 => [$fuzzy_impl, 2465, 2465, "UNCERTAIN",
108 => [$fuzzy_impl, 22, 22, "EXACT",
112 => [$fuzzy_impl, 22, 22, "UNCERTAIN",
116 => [$fuzzy_impl, undef, undef, "UNCERTAIN",
120 => [$fuzzy_impl, undef, 1, "BEFORE",
121 undef, undef, "UNCERTAIN",
124 => [$fuzzy_impl, undef, undef, "UNCERTAIN",
128 => [$fuzzy_impl, 1, 1, "EXACT",
129 undef, undef, "UNCERTAIN",
132 => [$fuzzy_impl, undef, undef, "UNCERTAIN",
133 undef, undef, "UNCERTAIN",
136 => [$fuzzy_impl, 1, 1, "UNCERTAIN",
141 my $locfac = Bio::Factory::FTLocationFactory->new();
142 isa_ok($locfac,'Bio::Factory::LocationFactoryI');
144 # sorting is to keep the order constant from one run to the next
145 foreach my $locstr (keys %testcases) {
146 my $loc = $locfac->from_string($locstr);
147 if($locstr eq "join(AY016290.1:108..185,AY016291.1:1546..1599)") {
148 $loc->seq_id("AY016295.1");
150 if($locstr eq "join(1..100,J00194.1:100..202)") {
151 $loc->seq_id("unknown");
153 my @res = @{$testcases{$locstr}};
154 is(ref($loc), $res[0], $res[0]);
155 is($loc->min_start(), $res[1]);
156 is($loc->max_start(), $res[2]);
157 is($loc->start_pos_type(), $res[3]);
158 is($loc->min_end(), $res[4]);
159 is($loc->max_end(), $res[5]);
160 is($loc->end_pos_type(), $res[6]);
161 is($loc->location_type(), $res[7]);
162 my @locs = $loc->each_Location();
164 my $ftstr = $loc->to_FTstring();
165 # this is a somewhat ugly hack, but we want clean output from to_FTstring()
166 # Umm, then these should really fail, correct?
167 # Should we be engineering workarounds for tests?
168 $locstr = "J00194:100..202" if $locstr eq "J00194:(100..202)";
169 $locstr = "(122.133)..(204.221)" if $locstr eq "((122.133)..(204.221))";
171 is($ftstr, $locstr, "Location String: $locstr");
172 # test strand production
173 is($loc->strand(), $res[9]);
177 skip('nested matches in regex only supported in v5.6.1 and higher', 8) unless $^V gt v5.6.0;
179 # Tests based on location definition (http://www.insdc.org/documents/feature_table.html#3.4)
180 my $string1 = 'complement(join(2691..4571,4918..5163))';
181 my $string2 = 'join(complement(4918..5163),complement(2691..4571))';
182 my $loc1 = $locfac->from_string($string1);
183 my $loc2 = $locfac->from_string($string2);
184 my $loc1_str = $loc1->to_FTstring;
185 my $loc2_str = $loc2->to_FTstring;
186 is($loc2_str, 'complement(join(2691..4571,4918..5163))', 'join(complement(4918..5163),complement(2691..4571))');
187 is($loc1_str, $loc2_str, 'equivalent location strings');
189 # bug #1674, #1765, 2101
190 # EMBL-like (BAC19856.3 protein)
191 # join(20464..20694,21548..22763,join(complement(314652..314672),complement(232596..232990),complement(231520..231669)))
193 # join(20464..20694,21548..22763,complement(join(231520..231669,232596..232990,314652..314672)))
195 # join(1000..2000,join(3000..4000,join(5000..6000,7000..8000)),9000..10000)
197 # join(1000..2000,3000..4000,5000..6000,7000..8000,9000..10000)
199 my @expected = (# intentionally testing same expected string twice
200 # as I am providing two different encodings
201 # that should mean the same thing
202 'join(11025..11049,complement(join(315036..315294,251354..251412,241499..241580,239890..240081)))',
203 'join(11025..11049,complement(join(315036..315294,251354..251412,241499..241580,239890..240081)))',
205 'join(20464..20694,21548..22763,complement(join(231520..231669,232596..232990,314652..314672)))',
206 'join(20464..20694,21548..22763,complement(join(231520..231669,232596..232990,314652..314672)))',
207 # this is just seen once
208 'join(1000..2000,3000..4000,5000..6000,7000..8000,9000..10000)',
209 'order(S67862.1:72..75,join(S67863.1:1..788,1..19))'
213 'join(11025..11049,join(complement(239890..240081),complement(241499..241580),complement(251354..251412),complement(315036..315294)))',
214 'join(11025..11049,complement(join(315036..315294,251354..251412,241499..241580,239890..240081)))',
215 'join(20464..20694,21548..22763,complement(join(231520..231669,232596..232990,314652..314672)))',
216 'join(20464..20694,21548..22763,join(complement(314652..314672),complement(232596..232990),complement(231520..231669)))',
217 'join(1000..2000,join(3000..4000,join(5000..6000,7000..8000)),9000..10000)',
218 'order(S67862.1:72..75,join(S67863.1:1..788,1..19))'
220 my $loc = $locfac->from_string($locstr);
221 my $ftstr = $loc->to_FTstring();
222 is($ftstr, shift @expected, $locstr);