From 85a7153f3cbf79ec974af2e8cf267d0a12e4e165 Mon Sep 17 00:00:00 2001 From: "Francisco J. Ossandon" Date: Sun, 8 Jun 2014 16:15:16 -0400 Subject: [PATCH] (Thomas Sibley): Tell Storable to freeze and thaw CODE refs By default it won't for security. This reverts commit 5dd8e967998c8ccc3305c5c41c4c2d6f4b6a3395: "skip tests if the cloning class used happens to be Storable, see bug #3447". The failing tests from Redmine issue #3447, t/Seq/Seq.t and t/SeqTools/SeqUtils.t, pass for me both with and without Clone available. I tested using -MDevel::Hide=-from:children,Clone. --- t/SeqTools/SeqUtils.t | 139 ++++++++++++++++++++++++-------------------------- 1 file changed, 67 insertions(+), 72 deletions(-) diff --git a/t/SeqTools/SeqUtils.t b/t/SeqTools/SeqUtils.t index 8f282d72c..194c25656 100644 --- a/t/SeqTools/SeqUtils.t +++ b/t/SeqTools/SeqUtils.t @@ -584,79 +584,74 @@ my ($fragment_feat_lig) = grep ($_->primary_tag eq 'frag_feat1', $product->get_S ok( $fragment_feat_lig, 'the fragment feature1 is now a feature of the product'); is_deeply( [$fragment_feat_lig->start, $fragment_feat_lig->end], [17,19], 'start and end of a feature on the fragment are correct after insertion with "flip" option'); - -SKIP: { - skip("Storable::dclone not supported yet for Bio::SeqUtils, see ", 9) if $Bio::Root::Root::CLONE_CLASS eq 'Storable'; - - # test clone_obj option (create new objects via clone not 'new') - my $foo_seq_obj = Bio::Seq::Foo->new( - -seq =>'aaaaaaaaaaccccccccccggggggggggtttttttttt', - -display_id => 'seq1', - -desc => 'some sequence for testing' - ); - for ($composite_feat1, $feature1, $feature2, $feature3, $feature4, $feature5) { - $foo_seq_obj->add_SeqFeature( $_ ); - } - $foo_seq_obj->annotation($coll); - - dies_ok( - sub { - $product = Bio::SeqUtils->delete( $foo_seq_obj, 11, 20, { clone_obj => 0} ); - }, - "Trying to delete from an object of a custom Bio::Seq subclass that doesn't allow calling 'new' throws an error" - ); - - lives_ok( - sub { - $product = Bio::SeqUtils->delete( $foo_seq_obj, 11, 20, { clone_obj => 1} ); - }, - "Deleting from Bio::Seq::Foo does not throw an error when using the 'clone_obj' option to clone instead of calling 'new'" - ); - - isa_ok( $product, 'Bio::Seq::Foo'); - - # just repeat some of the tests for the cloned feature - ok( - grep ($_ eq 'deletion of 10bp', - map ($_->get_tag_values('note'), - grep ($_->primary_tag eq 'misc_feature', $product->get_SeqFeatures) - ) - ), - "the product has an additional 'misc_feature' and the note specifies the lengths of the deletion'" - ); - ($composite_feat1_del) = grep ($_->primary_tag eq 'comp_feat1', $product->get_SeqFeatures); - ok ($composite_feat1_del, "The composite feature is still present"); - isa_ok( $composite_feat1_del, 'Bio::SeqFeature::Generic'); - isa_ok( $composite_feat1_del->location, 'Bio::Location::Split', "a composite feature that spanned the deletion site has been split up, Location"); - - # ligate with clone_obj - dies_ok( - sub { - $product = Bio::SeqUtils->ligate( - -recipient => $foo_seq_obj, - -fragment => $fragment_obj, - -left => 10, - -right => 31, - -flip => 1 - ); - }, - "'ligate' without clone_obj option dies with a Bio::Seq::Foo object that can't call new" - ); - - lives_ok( - sub { - $product = Bio::SeqUtils->ligate( - -recipient => $foo_seq_obj, - -fragment => $fragment_obj, - -left => 10, - -right => 31, - -flip => 1, - -clone_obj => 1, - ); - }, - "'ligate' with clone_obj option works with a Bio::Seq::Foo object that can't call new" - ); +# test clone_obj option (create new objects via clone not 'new') +my $foo_seq_obj = Bio::Seq::Foo->new( + -seq =>'aaaaaaaaaaccccccccccggggggggggtttttttttt', + -display_id => 'seq1', + -desc => 'some sequence for testing' +); +for ($composite_feat1, $feature1, $feature2, $feature3, $feature4, $feature5) { + $foo_seq_obj->add_SeqFeature( $_ ); } +$foo_seq_obj->annotation($coll); + +dies_ok( + sub { + $product = Bio::SeqUtils->delete( $foo_seq_obj, 11, 20, { clone_obj => 0} ); + }, + "Trying to delete from an object of a custom Bio::Seq subclass that doesn't allow calling 'new' throws an error" +); + +lives_ok( + sub { + $product = Bio::SeqUtils->delete( $foo_seq_obj, 11, 20, { clone_obj => 1} ); + }, + "Deleting from Bio::Seq::Foo does not throw an error when using the 'clone_obj' option to clone instead of calling 'new'" +); + +isa_ok( $product, 'Bio::Seq::Foo'); + +# just repeat some of the tests for the cloned feature +ok( + grep ($_ eq 'deletion of 10bp', + map ($_->get_tag_values('note'), + grep ($_->primary_tag eq 'misc_feature', $product->get_SeqFeatures) + ) + ), + "the product has an additional 'misc_feature' and the note specifies the lengths of the deletion'" +); +($composite_feat1_del) = grep ($_->primary_tag eq 'comp_feat1', $product->get_SeqFeatures); +ok ($composite_feat1_del, "The composite feature is still present"); +isa_ok( $composite_feat1_del, 'Bio::SeqFeature::Generic'); +isa_ok( $composite_feat1_del->location, 'Bio::Location::Split', "a composite feature that spanned the deletion site has been split up, Location"); + +# ligate with clone_obj +dies_ok( + sub { + $product = Bio::SeqUtils->ligate( + -recipient => $foo_seq_obj, + -fragment => $fragment_obj, + -left => 10, + -right => 31, + -flip => 1 + ); + }, + "'ligate' without clone_obj option dies with a Bio::Seq::Foo object that can't call new" +); + +lives_ok( + sub { + $product = Bio::SeqUtils->ligate( + -recipient => $foo_seq_obj, + -fragment => $fragment_obj, + -left => 10, + -right => 31, + -flip => 1, + -clone_obj => 1, + ); + }, + "'ligate' with clone_obj option works with a Bio::Seq::Foo object that can't call new" +); sub uniq_sort { my @args = @_; -- 2.11.4.GIT