[Bioperl-guts-l] [15637] bioperl-live/trunk: [bug 2810]

[Christopher John Fields]

Revision: 15637
Author:   cjfields
Date:     2009-04-15 11:38:39 -0400 (Wed, 15 Apr 2009)

Log Message:
-----------
[bug 2810]

* copy over tags properly from seqfeatures
* patch courtesy of David Jackson

Modified Paths:
--------------
    bioperl-live/trunk/Bio/SeqUtils.pm
    bioperl-live/trunk/t/SeqFeature/SeqFeature.t
    bioperl-live/trunk/t/SeqTools/SeqUtils.t

Modified: bioperl-live/trunk/Bio/SeqUtils.pm
===================================================================
--- bioperl-live/trunk/Bio/SeqUtils.pm	2009-04-15 15:33:48 UTC (rev 15636)
+++ bioperl-live/trunk/Bio/SeqUtils.pm	2009-04-15 15:38:39 UTC (rev 15637)
@@ -649,6 +649,9 @@
 	    $newfeat->annotation->add_Annotation($key, $value);
 	}
     } 
+    foreach my $key ( $feat->get_all_tags() ) {
+	    $newfeat->add_tag_value($key, $feat->get_tag_values($key));
+    } 
     if (@loc==1) {
         $newfeat->location($loc[0])
     } else {

Modified: bioperl-live/trunk/t/SeqFeature/SeqFeature.t
===================================================================
--- bioperl-live/trunk/t/SeqFeature/SeqFeature.t	2009-04-15 15:33:48 UTC (rev 15636)
+++ bioperl-live/trunk/t/SeqFeature/SeqFeature.t	2009-04-15 15:38:39 UTC (rev 15637)
@@ -7,7 +7,7 @@
     use lib '.';
     use Bio::Root::Test;
     
-    test_begin(-tests => 214);
+    test_begin(-tests => 222);
 	
 	use_ok('Bio::Seq');
 	use_ok('Bio::SeqIO');
@@ -363,3 +363,17 @@
     is ($sfseq->translate->subseq(1,10), $phase_check{$sfseq->subseq(1,10)}, 'phase check');
 }
 
+# tags
+$sf->add_tag_value('note','n1');
+$sf->add_tag_value('note','n2');
+$sf->add_tag_value('comment','c1');
+is_deeply( [sort $sf->get_all_tags()], [sort qw(note comment)] , 'tags found');
+is_deeply( [sort $sf->get_tagset_values('note')], [sort qw(n1 n2)] , 'get_tagset_values tag values found');
+is_deeply( [sort $sf->get_tagset_values(qw(note comment))], [sort qw(c1 n1 n2)] , 'get_tagset_values tag values for multiple tags found');
+lives_ok { 
+  is_deeply( [sort $sf->get_tag_values('note')], [sort qw(n1 n2)] , 'get_tag_values tag values found');
+} 'get_tag_values lives with tag';
+lives_ok { 
+  is_deeply( [$sf->get_tagset_values('notag') ], [], 'get_tagset_values no tag values found');
+} 'get_tagset_values lives with no tag';
+throws_ok { $sf->get_tag_values('notag') } qr/tag value that does not exist/, 'get_tag_values throws with no tag';

Modified: bioperl-live/trunk/t/SeqTools/SeqUtils.t
===================================================================
--- bioperl-live/trunk/t/SeqTools/SeqUtils.t	2009-04-15 15:33:48 UTC (rev 15636)
+++ bioperl-live/trunk/t/SeqTools/SeqUtils.t	2009-04-15 15:38:39 UTC (rev 15637)
@@ -5,9 +5,10 @@
 
 BEGIN {
     use lib '.';
+    use List::MoreUtils qw(uniq);
     use Bio::Root::Test;
     
-    test_begin(-tests => 43);
+    test_begin(-tests => 49);
 	
 	use_ok('Bio::PrimarySeq');
 	use_ok('Bio::SeqUtils');
@@ -193,7 +194,8 @@
                                       -end => 3,
                                       -strand => 1,
                                       -primary => 'hotspot',
-                                      -tag     => {note => ['note3a','note3b']},
+                                      -tag     => {note => ['note3a','note3b'], 
+                                                   comment => 'c1'},
 				       );
 
 $seq2->add_SeqFeature($ft2);
@@ -203,11 +205,13 @@
 ok (Bio::SeqUtils->cat($seq1, $seq2));
 is $seq1->seq, 'aaaattttcccctttt';
 is scalar $seq1->annotation->get_Annotations, 5;
+is_deeply([uniq sort map{$_->get_all_tags}$seq1->get_SeqFeatures], [sort qw(note comment)], 'cat - has expected tags');
+is_deeply([sort map{$_->get_tagset_values('note')}$seq1->get_SeqFeatures], [sort qw(note2 note3a note3b)], 'cat - has expected tag values');
 my @tags;
 lives_ok {
   @tags = map{$_->get_tag_values(q(note))}$seq1->get_SeqFeatures ;
-} 'tags transfered (no throw)';
-cmp_ok(scalar(@tags),'==',3, 'tags transfered (correct count)') ;
+} 'cat - note tag transfered (no throw)';
+cmp_ok(scalar(@tags),'==',3, 'cat - note tag values transfered (correct count)') ;
 
 
 my $protseq = Bio::PrimarySeq->new(-id => 2, -seq => 'MVTF'); # protein seq
@@ -243,6 +247,7 @@
                                       -end => 4,
                                       -strand => 1,
                                       -primary => 'source',
+                                      -tag     => {note => 'note2'},
                                        );
 
 
@@ -250,6 +255,8 @@
                                       -end => 8,
                                       -strand => -1,
                                       -primary => 'hotspot',
+                                      -tag     => {note => ['note3a','note3b'], 
+                                                   comment => 'c1'},
                                        );
 $seq2->add_SeqFeature($ft2);
 $seq2->add_SeqFeature($ft3);
@@ -259,9 +266,13 @@
 my @feat=$trunc->get_SeqFeatures;
 is $feat[0]->location->to_FTstring, '<1..3';
 is $feat[1]->location->to_FTstring, 'complement(4..>6)';
+is_deeply([uniq sort map{$_->get_all_tags}$trunc->get_SeqFeatures], [sort qw(note comment)], 'trunc_with_features - has expected tags');
+is_deeply([sort map{$_->get_tagset_values('note')}$trunc->get_SeqFeatures], [sort qw(note2 note3a note3b)], 'trunc_with_features - has expected tag values');
 
 my $revcom=Bio::SeqUtils->revcom_with_features($seq2);
 is $revcom->seq, 'ttttaacc';
 my @revfeat=$revcom->get_SeqFeatures;
 is $revfeat[0]->location->to_FTstring, 'complement(5..8)';
 is $revfeat[1]->location->to_FTstring, '1..4';
+is_deeply([uniq sort map{$_->get_all_tags}$revcom->get_SeqFeatures], [sort qw(note comment)], 'revcom_with_features - has expected tags');
+is_deeply([sort map{$_->get_tagset_values('note')}$revcom->get_SeqFeatures], [sort qw(note2 note3a note3b)], 'revcom_with_features - has expected tag values');