| Subject: | Perl v5.13.0-58-gefaf367 broke SREZIC/Tk-804.030.tar.gz |
The attached program exposes the effect of the change referenced in the
subject. Before the change the Label widget displayed the formatted
running time just fine, but after the change it doesn't. Instead it
displays random strings, often Unicode strings, but also often nothing
at all. Here is the commit message of he change:
commit efaf36747029c85b4d8825318cb4d485a0bb350e
Author: David Mitchell <davem@iabyn.com>
Date: Sun Apr 25 00:56:32 2010 +0100
add Perl_magic_methcall
Add a new function that wraps the setup needed to call a magic
method like
FETCH (the existing S_magic_methcall function has been renamed
S_magic_methcall1).
There is one functional change, done mainly to allow for a single clean
wrapper function, and that is that the method calls are no longer
wrapped
with SAVETMPS/FREETMPS. Previously only about half of them had this, so
some relied on the caller to free, some didn't. At least we're
consistent
now. Doing it this way is necessary because otherwise magic_methcall()
can't return an SV (eg for POP) because it'll be a temp and get freed by
FREETMPS before it gets returned. So you'd have to copy everything,
which
would slow things down.
HTH,
| Subject: | tkstopwatch.pl |
use Tk;
use Tk::ProgressBar;
use strict;
our $TV = "0.00";
my(%tinfo) =
(
w => undef,
s => 0,
h => 0,
p => 1,
);
sub tick {
return if $tinfo{p};
$tinfo{h} += 5;
if ($tinfo{h} >= 100) {
$tinfo{h} = 0;
$tinfo{s}++;
}
$TV = sprintf("%d.%02d", $tinfo{s}, $tinfo{h});
$tinfo{w}->after(50, \&tick);
}
my $MW = MainWindow->new;
$MW->bind('<Control-c>' => \&exit);
$MW->bind('<Control-q>' => \&exit);
$tinfo{w} = $MW;
my $start = $MW->Button(
-text => 'Start/Pause',
-command => sub {$tinfo{p}^=1; tick},
);
my $counter = $MW->Label(
-relief => 'raised',
-width => 10,
-textvariable => \$TV,
);
$counter->pack(-side => 'bottom', -fill => 'both');
$start->pack(-side => 'bottom', -fill => 'both', -expand => 'yes');
my $pb = $MW->ProgressBar(
-width => 200,
-length => 800,
-anchor => "w",
-from => 0,
-to => 800,
-blocks => 800,
-colors => [0, "green"],
-variable => \$TV,
)->pack;
MainLoop;