Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

various changes to get rid of t-test non-critical errors

svn path=/bioperl-gui/trunk/; revision=766
  • Loading branch information...
commit 4f2d06031f2e50f49ab76ecacb26148da63b5ca2 1 parent 4754383
mwilkinson authored
32 Bio/Tk/SeqCanvas.pm
@@ -465,8 +465,8 @@ $Bio::Tk::SeqCanvas::VERSION='3.0';
465 465
466 466 );
467 467
468   - my $_nextDoffset;
469   - my $_nextFoffset;
  468 + my $_nextDoffset=0;
  469 + my $_nextFoffset=0;
470 470 # note that these are encapsulated CLASS properties
471 471 my %colors; # and thus are constant from one instantiation to the next
472 472 my $_color_pos = 0;
@@ -479,6 +479,7 @@ $Bio::Tk::SeqCanvas::VERSION='3.0';
479 479 # Is a specified object attribute accessible in a given mode
480 480 sub _accessible {
481 481 my ($self, $attr, $mode) = @_;
  482 + return 0 unless ($_attr_data{$attr}[1] && $mode);
482 483 $_attr_data{$attr}[1] =~ /$mode/
483 484 }
484 485
@@ -737,18 +738,15 @@ sub new {
737 738
738 739 delete $args{-orientation};
739 740
740   - foreach (keys %args) {
741   - foreach my $attrname ( $self->_standard_keys ) {
742   - next if $attrname eq "-orientation";
743   - if (exists $args{$attrname}) {
744   - $self->{$attrname} = $args{$attrname} }
745   - elsif ($caller_is_obj) {
746   - $self->{$attrname} = $caller->{$attrname} }
747   - else {
748   - $self->{$attrname} = $self->_default_for($attrname) }
749   - }
  741 + foreach my $attrname ( $self->_standard_keys ) {
  742 + next if $attrname eq "-orientation";
  743 + if (exists $args{$attrname}) {
  744 + $self->{$attrname} = $args{$attrname} }
  745 + elsif ($caller_is_obj) {
  746 + $self->{$attrname} = $caller->{$attrname} }
  747 + else {
  748 + $self->{$attrname} = $self->_default_for($attrname) }
750 749 }
751   -
752 750
753 751 $self->SysMess($TOP); # a handle out to the top-level window system for passing messages
754 752
@@ -1141,7 +1139,8 @@ sub _examine_DnD_Motion {
1141 1139
1142 1140 # we are over an existing widget, but it must be a type that can accept drag and drop
1143 1141 my @tags = $dest->gettags($widget); # get the tags from this widget
1144   - my ($FeatureID, $strand, $source, $start, $stop, $offset, $primary_tag) = _extractTags(\@tags);
  1142 + my ($FeatureID, $strand, $start, $stop, $offset, $primary_tag);
  1143 + ($FeatureID, $strand, $source, $start, $stop, $offset, $primary_tag) = _extractTags(\@tags);
1145 1144 return unless ($FeatureID); # all sorts of things can appear here... so make sure it is a genuine feature
1146 1145
1147 1146 my $SCF = $self->AllFeatures($FeatureID); # get the SeqCanvasFeature for this widget
@@ -1283,8 +1282,7 @@ sub _receiveDropOnWidget {
1283 1282 sub _receiveDropCreateNewGene {
1284 1283 my ($self) = @_;
1285 1284 my %features = %{$self->getSelectedFeatures};
1286   - my $strand;
1287   - my $start = 0; my $stop = 0; my $strand; # get the dimensions of the new transcript
  1285 + my $strand;my $start = 0; my $stop = 0; # get the dimensions of the new transcript
1288 1286 foreach my $feature(values %features){
1289 1287 next unless $feature;
1290 1288 unless ($feature->end < $stop){$stop = $feature->end}
@@ -2160,7 +2158,7 @@ sub _isLabel {
2160 2158 if ($canvas eq "draft"){
2161 2159 @tags = $self->DraftCanvas->gettags($widgetTkID);
2162 2160 } else {
2163   - @tags, $self->FinishedCanvas->gettags($widgetTkID);
  2161 + @tags = $self->FinishedCanvas->gettags($widgetTkID);
2164 2162 }
2165 2163 foreach my $tag(@tags){
2166 2164 if ($tag eq "bioTk_Map_Label"){return 1}
3  Bio/Tk/SeqCanvasFeature.pm
@@ -274,7 +274,7 @@ sub _draw {
274 274 my $FID = $self->FID;
275 275 my $color = $self->color;
276 276 my $label;
277   - if ($self->has_tag($self->label)){
  277 + if ($self->label && $self->has_tag($self->label)){
278 278 if ($self->Feature->strand == -1) {
279 279 $self->offset($self->offset - 5);
280 280 }
@@ -424,5 +424,6 @@ sub gff_string {
424 424 return $self->Feature->gff_string($format);
425 425 }
426 426
  427 +sub DESTROY {}
427 428
428 429 1;
2  t/seqcanvas.t
@@ -40,7 +40,7 @@ eval {
40 40 my $frame = $top->Frame('-background' => '#ffffff')->pack(-side => 'top', -fill => 'both');
41 41 my ($axis_length) = 900;
42 42
43   - $MapObj = Bio::Tk::SeqCanvas->new($axis_length, $frame, undef, $SeqObj, -orientation => 'vertical'); # $MapObj is a handle to the map objects that you have just created
  43 + $MapObj = Bio::Tk::SeqCanvas->new($axis_length, $frame, $top, $SeqObj, -orientation => 'vertical'); # $MapObj is a handle to the map objects that you have just created
44 44 } else {
45 45 print "not ok 2\n";
46 46 }

0 comments on commit 4f2d060

Please sign in to comment.
Something went wrong with that request. Please try again.