← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to t/LocationFactory.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/LocationFactory.t
1
1
# -*-Perl-*-
2
2
## Bioperl Test Harness Script for Modules
3
 
## $Id: LocationFactory.t,v 1.4 2002/12/28 03:26:33 lapp Exp $
 
3
## $Id: LocationFactory.t,v 1.12.4.4 2006/11/08 17:25:55 sendu Exp $
4
4
 
5
5
# Before `make install' is performed this script should be runnable with
6
6
# `make test'. After `make install' it should work as `perl test.t'
10
10
    # to handle systems with no installed Test module
11
11
    # we include the t dir (where a copy of Test.pm is located)
12
12
    # as a fallback
13
 
    eval { require Test; };
14
 
    if( $@ ) {
15
 
        use lib 't';
 
13
    eval { require Test::More; };
 
14
    if ( $@ ) {
 
15
                use lib 't/lib';
16
16
    }
17
 
    use Test;
18
 
    plan tests => 177;
 
17
    use Test::More;
 
18
    plan tests => 275;
19
19
}
20
20
 
21
 
use Bio::Factory::FTLocationFactory;
22
 
use Bio::Factory::LocationFactoryI;
23
 
use Bio::Location::Simple;
24
 
use Bio::Location::Split;
25
 
use Bio::Location::Fuzzy;
 
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
26
 
27
27
my $simple_impl = "Bio::Location::Simple";
28
28
my $fuzzy_impl = "Bio::Location::Fuzzy";
32
32
# min/max start position and position type, min/max end position and position
33
33
# type, location type, the number of locations, and the strand.
34
34
#
35
 
# note: the following are directly taken from 
36
 
# http://www.ncbi.nlm.nih.gov/collab/FT/#location
37
 
my %testcases = ("467" => [$simple_impl,
38
 
                   467, 467, "EXACT", 467, 467, "EXACT", "EXACT", 1, 1],
39
 
                 "340..565" => [$simple_impl,
40
 
                   340, 340, "EXACT", 565, 565, "EXACT", "EXACT", 1, 1],
41
 
                 "<345..500" => [$fuzzy_impl,
42
 
                   undef, 345, "BEFORE", 500, 500, "EXACT", "EXACT", 1, 1],
43
 
                 "<1..888" => [$fuzzy_impl,
44
 
                   undef, 1, "BEFORE", 888, 888, "EXACT", "EXACT", 1, 1],
45
 
                 "(102.110)" => [$fuzzy_impl,
46
 
                   102, 102, "EXACT", 110, 110, "EXACT", "WITHIN", 1, 1],
47
 
                 "(23.45)..600" => [$fuzzy_impl,
48
 
                   23, 45, "WITHIN", 600, 600, "EXACT", "EXACT", 1, 1],
49
 
                 "(122.133)..(204.221)" => [$fuzzy_impl,
50
 
                   122, 133, "WITHIN", 204, 221, "WITHIN", "EXACT", 1, 1],
51
 
                 "123^124" => [$simple_impl,
52
 
                   123, 123, "EXACT", 124, 124, "EXACT", "IN-BETWEEN", 1, 1],
53
 
                 "145^177" => [$fuzzy_impl,
54
 
                   145, 145, "EXACT", 177, 177, "EXACT", "BETWEEN", 1, 1],
55
 
                 "join(12..78,134..202)" => [$split_impl,
56
 
                   12, 12, "EXACT", 202, 202, "EXACT", "EXACT", 2, 1],
57
 
                 "join(complement(4918..5163),complement(2691..4571))" => [$split_impl,
58
 
                   2691, 2691, "EXACT", 5163, 5163, "EXACT", "EXACT", 2, -1],
59
 
                 "complement(34..(122.126))" => [$fuzzy_impl,
60
 
                   34, 34, "EXACT", 122, 126, "WITHIN", "EXACT", 1, -1],
61
 
                 "J00194:100..202" => [$simple_impl,
62
 
                   100, 100, "EXACT", 202, 202, "EXACT", "EXACT", 1, 1],
63
 
                 # this variant is not really allowed by the FT definition
64
 
                 # document but we want to be able to cope with it
65
 
                 "J00194:(100..202)" => [$simple_impl,
66
 
                   100, 100, "EXACT", 202, 202, "EXACT", "EXACT", 1, 1],
67
 
                 "((122.133)..(204.221))" => [$fuzzy_impl,
68
 
                   122, 133, "WITHIN", 204, 221, "WITHIN", "EXACT", 1, 1],
69
 
                 "join(AY016290.1:108..185,AY016291.1:1546..1599)"=>
70
 
                 [$split_impl,
71
 
                  108, 108, "EXACT", 185, 185, "EXACT", "EXACT", 2, undef] 
 
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]
72
93
                 );
73
94
 
74
95
my $locfac = Bio::Factory::FTLocationFactory->new();
75
 
ok($locfac->isa("Bio::Factory::LocationFactoryI"));
 
96
isa_ok($locfac,'Bio::Factory::LocationFactoryI');
76
97
 
77
98
# sorting is to keep the order constant from one run to the next
78
 
foreach my $locstr (sort keys(%testcases)) { 
79
 
    my $loc = $locfac->from_string($locstr);
80
 
    if($locstr eq "join(AY016290.1:108..185,AY016291.1:1546..1599)") {
81
 
        $loc->seq_id("AY016295.1");
82
 
    }
83
 
    my @res = @{$testcases{$locstr}};
84
 
    ok(ref($loc), $res[0]);
85
 
    ok($loc->min_start(), $res[1]);
86
 
    ok($loc->max_start(), $res[2]);
87
 
    ok($loc->start_pos_type(), $res[3]);
88
 
    ok($loc->min_end(), $res[4]);
89
 
    ok($loc->max_end(), $res[5]);
90
 
    ok($loc->end_pos_type(), $res[6]);
91
 
    ok($loc->location_type(), $res[7]);
92
 
    my @locs = $loc->each_Location();
93
 
    ok(@locs, $res[8]);
94
 
    my $ftstr = $loc->to_FTstring();
95
 
    # this is a somewhat ugly hack, but we want clean output from to_FTstring()
96
 
    $locstr = "J00194:100..202" if $locstr eq "J00194:(100..202)";
97
 
    $locstr = "(122.133)..(204.221)" if $locstr eq "((122.133)..(204.221))";
98
 
    # now test
99
 
    ok($ftstr, $locstr);
100
 
    # test strand production
101
 
    ok($loc->strand(), $res[9]);
102
 
}
103
 
   
 
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
}