Permalink
Browse files

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

svn path=/bioperl-gui/trunk/; revision=766
  • Loading branch information...
1 parent 4754383 commit 4f2d06031f2e50f49ab76ecacb26148da63b5ca2 mwilkinson committed Apr 22, 2003
Showing with 18 additions and 19 deletions.
  1. +15 −17 Bio/Tk/SeqCanvas.pm
  2. +2 −1 Bio/Tk/SeqCanvasFeature.pm
  3. +1 −1 t/seqcanvas.t
View
32 Bio/Tk/SeqCanvas.pm
@@ -465,8 +465,8 @@ $Bio::Tk::SeqCanvas::VERSION='3.0';
);
- my $_nextDoffset;
- my $_nextFoffset;
+ my $_nextDoffset=0;
+ my $_nextFoffset=0;
# note that these are encapsulated CLASS properties
my %colors; # and thus are constant from one instantiation to the next
my $_color_pos = 0;
@@ -479,6 +479,7 @@ $Bio::Tk::SeqCanvas::VERSION='3.0';
# Is a specified object attribute accessible in a given mode
sub _accessible {
my ($self, $attr, $mode) = @_;
+ return 0 unless ($_attr_data{$attr}[1] && $mode);
$_attr_data{$attr}[1] =~ /$mode/
}
@@ -737,18 +738,15 @@ sub new {
delete $args{-orientation};
- foreach (keys %args) {
- foreach my $attrname ( $self->_standard_keys ) {
- next if $attrname eq "-orientation";
- if (exists $args{$attrname}) {
- $self->{$attrname} = $args{$attrname} }
- elsif ($caller_is_obj) {
- $self->{$attrname} = $caller->{$attrname} }
- else {
- $self->{$attrname} = $self->_default_for($attrname) }
- }
+ foreach my $attrname ( $self->_standard_keys ) {
+ next if $attrname eq "-orientation";
+ if (exists $args{$attrname}) {
+ $self->{$attrname} = $args{$attrname} }
+ elsif ($caller_is_obj) {
+ $self->{$attrname} = $caller->{$attrname} }
+ else {
+ $self->{$attrname} = $self->_default_for($attrname) }
}
-
$self->SysMess($TOP); # a handle out to the top-level window system for passing messages
@@ -1141,7 +1139,8 @@ sub _examine_DnD_Motion {
# we are over an existing widget, but it must be a type that can accept drag and drop
my @tags = $dest->gettags($widget); # get the tags from this widget
- my ($FeatureID, $strand, $source, $start, $stop, $offset, $primary_tag) = _extractTags(\@tags);
+ my ($FeatureID, $strand, $start, $stop, $offset, $primary_tag);
+ ($FeatureID, $strand, $source, $start, $stop, $offset, $primary_tag) = _extractTags(\@tags);
return unless ($FeatureID); # all sorts of things can appear here... so make sure it is a genuine feature
my $SCF = $self->AllFeatures($FeatureID); # get the SeqCanvasFeature for this widget
@@ -1283,8 +1282,7 @@ sub _receiveDropOnWidget {
sub _receiveDropCreateNewGene {
my ($self) = @_;
my %features = %{$self->getSelectedFeatures};
- my $strand;
- my $start = 0; my $stop = 0; my $strand; # get the dimensions of the new transcript
+ my $strand;my $start = 0; my $stop = 0; # get the dimensions of the new transcript
foreach my $feature(values %features){
next unless $feature;
unless ($feature->end < $stop){$stop = $feature->end}
@@ -2160,7 +2158,7 @@ sub _isLabel {
if ($canvas eq "draft"){
@tags = $self->DraftCanvas->gettags($widgetTkID);
} else {
- @tags, $self->FinishedCanvas->gettags($widgetTkID);
+ @tags = $self->FinishedCanvas->gettags($widgetTkID);
}
foreach my $tag(@tags){
if ($tag eq "bioTk_Map_Label"){return 1}
View
3 Bio/Tk/SeqCanvasFeature.pm
@@ -274,7 +274,7 @@ sub _draw {
my $FID = $self->FID;
my $color = $self->color;
my $label;
- if ($self->has_tag($self->label)){
+ if ($self->label && $self->has_tag($self->label)){
if ($self->Feature->strand == -1) {
$self->offset($self->offset - 5);
}
@@ -424,5 +424,6 @@ sub gff_string {
return $self->Feature->gff_string($format);
}
+sub DESTROY {}
1;
View
2 t/seqcanvas.t
@@ -40,7 +40,7 @@ eval {
my $frame = $top->Frame('-background' => '#ffffff')->pack(-side => 'top', -fill => 'both');
my ($axis_length) = 900;
- $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
+ $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
} else {
print "not ok 2\n";
}

0 comments on commit 4f2d060

Please sign in to comment.