1 # -*-Perl-*- Test Harness script for Bioperl
10 test_begin(-tests => 155);
12 use_ok('Bio::Annotation::Collection');
13 use_ok('Bio::Annotation::DBLink');
14 use_ok('Bio::Annotation::Comment');
15 use_ok('Bio::Annotation::Reference');
16 use_ok('Bio::Annotation::SimpleValue');
17 use_ok('Bio::Annotation::Target');
18 use_ok('Bio::Annotation::AnnotationFactory');
19 use_ok('Bio::Annotation::StructuredValue');
20 use_ok('Bio::Annotation::TagTree');
21 use_ok('Bio::Annotation::Tree');
23 use_ok('Bio::SeqFeature::Annotated');
24 use_ok('Bio::SimpleAlign');
25 use_ok('Bio::Cluster::UniGene');
28 my $DEBUG = test_debug();
32 my $simple = Bio::Annotation::SimpleValue->new(-tagname => 'colour',
36 isa_ok($simple, 'Bio::AnnotationI');
37 is $simple->display_text, 1;
39 is $simple->tagname, 'colour';
41 is $simple->value(0), 0;
43 is $simple->display_text, 0;
47 my $link1 = Bio::Annotation::DBLink->new(-database => 'TSC',
48 -primary_id => 'TSC0000030',
50 isa_ok($link1,'Bio::AnnotationI');
51 is $link1->database(), 'TSC';
52 is $link1->primary_id(), 'TSC0000030';
53 is $link1->as_text, 'Direct database link to TSC0000030 in database TSC';
54 my $ac = Bio::Annotation::Collection->new();
55 isa_ok($ac,'Bio::AnnotationCollectionI');
57 $ac->add_Annotation('dblink',$link1);
58 $ac->add_Annotation('dblink',
59 Bio::Annotation::DBLink->new(-database => 'TSC',
60 -primary_id => 'HUM_FABV'));
62 my $comment = Bio::Annotation::Comment->new( '-text' => 'sometext');
63 is $comment->text, 'sometext';
64 is $comment->as_text, 'Comment: sometext';
65 $ac->add_Annotation('comment', $comment);
69 my $target = Bio::Annotation::Target->new(-target_id => 'F321966.1',
74 isa_ok($target,'Bio::AnnotationI');
75 ok $ac->add_Annotation('target', $target);
78 my $ref = Bio::Annotation::Reference->new( -authors => 'author line',
79 -title => 'title line',
80 -location => 'location line',
82 isa_ok($ref,'Bio::AnnotationI');
83 is $ref->authors, 'author line';
84 is $ref->title, 'title line';
85 is $ref->location, 'location line';
87 is $ref->database, 'MEDLINE';
88 is $ref->as_text, 'Reference: title line';
89 $ac->add_Annotation('reference', $ref);
93 foreach my $link ( $ac->get_Annotations('dblink') ) {
94 is $link->database, 'TSC';
95 is $link->tagname(), 'dblink';
101 my @keys = $ac->get_all_annotation_keys();
102 is (scalar(@keys), 4);
103 foreach my $ann ( $ac->get_Annotations() ) {
104 shift(@keys) if ($n > 0) && ($ann->tagname ne $keys[0]);
105 is $ann->tagname(), $keys[0];
110 $ac->add_Annotation($link1);
113 foreach my $link ( $ac->get_Annotations('dblink') ) {
114 is $link->tagname(), 'dblink';
119 # annotation of structured simple values (like swissprot''is GN line)
120 my $ann = Bio::Annotation::StructuredValue->new();
121 isa_ok($ann, "Bio::AnnotationI");
123 $ann->add_value([-1], "val1");
124 is ($ann->value(), "val1");
125 $ann->value("compat test");
126 is ($ann->value(), "compat test");
127 $ann->add_value([-1], "val2");
128 is ($ann->value(-joins => [" AND "]), "compat test AND val2");
129 $ann->add_value([0], "val1");
130 is ($ann->value(-joins => [" AND "]), "val1 AND val2");
131 $ann->add_value([-1,-1], "val3", "val4");
132 $ann->add_value([-1,-1], "val5", "val6");
133 $ann->add_value([-1,-1], "val7");
134 is ($ann->value(-joins => [" AND "]), "val1 AND val2 AND (val3 AND val4) AND (val5 AND val6) AND val7");
135 is ($ann->value(-joins => [" AND ", " OR "]), "val1 AND val2 AND (val3 OR val4) AND (val5 OR val6) AND val7");
138 foreach ($ann->get_all_values()) {
143 my $nested_ac = Bio::Annotation::Collection->new();
144 $nested_ac->add_Annotation('nested', $ac);
146 is (scalar($nested_ac->get_Annotations()), 1);
147 ($ac) = $nested_ac->get_Annotations();
148 isa_ok($ac, "Bio::AnnotationCollectionI");
149 is (scalar($nested_ac->get_all_Annotations()), 6);
150 $nested_ac->add_Annotation('gene names', $ann);
151 is (scalar($nested_ac->get_Annotations()), 2);
152 is (scalar($nested_ac->get_all_Annotations()), 7);
153 is (scalar($nested_ac->get_Annotations('dblink')), 0);
154 my @anns = $nested_ac->get_Annotations('gene names');
155 isa_ok($anns[0], "Bio::Annotation::StructuredValue");
156 @anns = map { $_->get_Annotations('dblink');
157 } $nested_ac->get_Annotations('nested');
158 is (scalar(@anns), 3);
159 is (scalar($nested_ac->flatten_Annotations()), 2);
160 is (scalar($nested_ac->get_Annotations()), 7);
161 is (scalar($nested_ac->get_all_Annotations()), 7);
164 test_skip(-tests => 7, -requires_modules => [qw(Graph::Directed Bio::Annotation::OntologyTerm)]);
165 use_ok('Bio::Annotation::OntologyTerm');
166 # OntologyTerm annotation
167 my $termann = Bio::Annotation::OntologyTerm->new(-label => 'test case',
168 -identifier => 'Ann:00001',
169 -ontology => 'dumpster');
170 isa_ok($termann->term,'Bio::Ontology::Term');
171 is ($termann->term->name, 'test case');
172 is ($termann->term->identifier, 'Ann:00001');
173 is ($termann->tagname, 'dumpster');
174 is ($termann->ontology->name, 'dumpster');
175 is ($termann->as_text, "dumpster|test case|");
179 my $seq = Bio::Seq->new();
180 isa_ok($seq,"Bio::AnnotatableI");
181 my $fea = Bio::SeqFeature::Annotated->new();
182 isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
183 isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
184 $fea = Bio::SeqFeature::Generic->new();
185 isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
186 isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
187 my $clu = Bio::Cluster::UniGene->new();
188 isa_ok($clu, "Bio::AnnotatableI");
189 my $aln = Bio::SimpleAlign->new();
190 isa_ok($clu,"Bio::AnnotatableI");
192 # tests for Bio::Annotation::AnnotationFactory
194 my $factory = Bio::Annotation::AnnotationFactory->new;
195 isa_ok($factory, 'Bio::Factory::ObjectFactoryI');
197 # defaults to SimpleValue
198 $ann = $factory->create_object(-value => 'peroxisome',
199 -tagname => 'cellular component');
200 like(ref $ann, qr(Bio::Annotation::SimpleValue));
202 $factory->type('Bio::Annotation::OntologyTerm');
204 $ann = $factory->create_object(-name => 'peroxisome',
205 -tagname => 'cellular component');
207 like(ref($ann), qr(Bio::Annotation::OntologyTerm));
209 $ann = $factory->create_object(-text => 'this is a comment');
210 ok(defined $ann,'Bio::Annotation::Comment');
213 local $TODO = "Create Annotation::Comment based on parameter only";
214 isa_ok($ann,'Bio::Annotation::Comment');
217 ok $factory->type('Bio::Annotation::Comment');
218 $ann = $factory->create_object(-text => 'this is a comment');
219 ok(defined $ann,'Bio::Annotation::Comment');
220 isa_ok($ann,'Bio::Annotation::Comment');
222 # factory guessing the type: Comment
223 $factory = Bio::Annotation::AnnotationFactory->new();
224 $ann = $factory->create_object(-text => 'this is a comment');
225 ok(defined $ann,'Bio::Annotation::Comment');
226 isa_ok($ann,'Bio::Annotation::Comment');
228 # factory guessing the type: Target
229 $factory = Bio::Annotation::AnnotationFactory->new();
230 $ann = $factory->create_object(-target_id => 'F1234',
234 isa_ok($ann,'Bio::Annotation::Target');
236 # factory guessing the type: OntologyTerm
237 $factory = Bio::Annotation::AnnotationFactory->new();
238 ok(defined ($ann = $factory->create_object(-name => 'peroxisome',
239 -tagname => 'cellular component')));
240 like(ref $ann, qr(Bio::Annotation::OntologyTerm));
243 my $tree_filename = test_input_file('longnames.dnd');
244 my $tree = Bio::TreeIO->new(-file=>$tree_filename)->next_tree();
245 my $ann_tree = Bio::Annotation::Tree->new(
250 isa_ok($ann_tree, 'Bio::AnnotationI');
251 $ann_tree->tree_id('test');
252 is $ann_tree->tree_id(), 'test', "tree_id()";
253 $ann_tree->tagname('tree');
254 is $ann_tree->tagname(), 'tree', "tagname()";
255 my $aln_filename = test_input_file('longnames.aln');
257 $aln = Bio::AlignIO->new(-file => $aln_filename,
258 -format=>'clustalw')->next_aln();
259 isa_ok($aln, 'Bio::AnnotatableI');
260 $ac = Bio::Annotation::Collection->new();
261 $ac->add_Annotation('tree',$ann_tree);
262 $aln->annotation($ac);
263 for my $treeblock ( $aln->annotation->get_Annotations('tree') ) {
264 my $treeref = $treeblock->tree();
265 my @nodes = sort { defined $a->id &&
267 $a->id cmp $b->id } $treeref->get_nodes();
268 is $nodes[12]->id, '183.m01790', "add tree to AlignI";
270 for my $seq ($aln->each_seq_with_id($nodes[12]->id)) {
271 $str = $seq->subseq(1,20);
273 is( $str, "MDDKELEIPVEHSTAFGQLV", "get seq from node id");
277 my $struct = [ 'genenames' => [
279 [ 'Name' => 'CALM1' ],
280 ['Synonyms'=> 'CAM1'],
281 ['Synonyms'=> 'CALM'],
282 ['Synonyms'=> 'CAM' ] ] ],
284 [ 'Name'=> 'CALM2' ],
285 [ 'Synonyms'=> 'CAM2'],
286 [ 'Synonyms'=> 'CAMB'] ] ],
288 [ 'Name'=> 'CALM3' ],
289 [ 'Synonyms'=> 'CAM3' ],
290 [ 'Synonyms'=> 'CAMC' ] ] ]
293 my $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'gn',
296 isa_ok($ann_struct, 'Bio::AnnotationI');
297 my $val = $ann_struct->value;
298 like($val, qr/Name: CALM1/,'default itext');
301 my $ann_struct2 = Bio::Annotation::TagTree->new(-tagname => 'gn',
303 is($ann_struct2->value, $val,'roundtrip');
306 like($ann_struct2->value, qr/Name: CALM1/,'itext');
307 $ann_struct2->tagformat('sxpr');
308 like($ann_struct2->value, qr/\(Name "CALM1"\)/,'spxr');
309 $ann_struct2->tagformat('indent');
310 like($ann_struct2->value, qr/Name "CALM1"/,'indent');
313 eval {require XML::Parser::PerlSAX};
314 skip ("XML::Parser::PerlSAX rquired for XML",1) if $@;
315 $ann_struct2->tagformat('xml');
316 like($ann_struct2->value, qr/<Name>CALM1<\/Name>/,'xml');
319 # grab Data::Stag nodes, use Data::Stag methods
320 my @nodes = $ann_struct2->children;
321 for my $node (@nodes) {
322 isa_ok($node, 'Data::Stag::StagI');
323 is($node->element, 'genename');
324 # add tag-value data to node
325 $node->set('foo', 'bar');
327 like($node->itext, qr/foo:\s+bar/,'child changes');
330 $ann_struct2->tagformat('itext');
331 like($ann_struct2->value, qr/foo:\s+bar/,'child changes in parent node');
333 # pass in a Data::Stag node to value()
334 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
335 like($ann_struct->value, qr/^\s+:\s+$/xms, 'no tags');
336 like($ann_struct->value, qr/^\s+:\s+$/xms,'before Stag node');
337 $ann_struct->value($nodes[0]);
338 like($ann_struct->value, qr/Name: CALM1/,'after Stag node');
339 is(ref $ann_struct->node, ref $nodes[0], 'both stag nodes');
340 isnt($ann_struct->node, $nodes[0], 'different instances');
342 # pass in another TagTree to value()
343 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
344 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
345 $ann_struct->value($ann_struct2);
346 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
347 is(ref $ann_struct->node, ref $ann_struct2->node, 'both stag nodes');
348 isnt($ann_struct->node, $ann_struct2->node, 'different instances');
350 # replace the Data::Stag node in the annotation (no copy)
351 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
352 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
353 $ann_struct->node($nodes[1]);
354 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
355 is(ref $ann_struct->node, ref $ann_struct2->node, 'stag nodes');
356 is($ann_struct->node, $nodes[1], 'same instance');
357 # replace the Data::Stag node in the annotation (use duplicate)
358 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
359 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
360 $ann_struct->node($nodes[1],'copy');
361 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
362 is(ref $ann_struct->node, ref $ann_struct2->node, 'stag nodes');
363 isnt($ann_struct->node, $nodes[1], 'different instance');
365 #check insertion in to collection
366 $ann_struct = Bio::Annotation::TagTree->new(-value => $struct);
367 $ac = Bio::Annotation::Collection->new();
369 $ac->add_Annotation('genenames',$ann_struct);
371 for my $tagtree ( $ac->get_Annotations('genenames') ) {
372 isa_ok($tagtree, 'Bio::AnnotationI');
373 for my $node ($tagtree->children) {
374 isa_ok($node, 'Data::Stag::StagI');
375 like($node->itext, qr/Name:\s+CALM/,'child changes');