我下面有perl Tk子例程，当在我们的小型专用LAN上的某些Centos 6机器上重复运行时，出现以下错误:
0 0x95ac3b8 PVMG f=0008e507 {}(1)(3)
SV = PVMG(0x9471dc0) at 0x95ac3b8
REFCNT = 3
FLAGS = (PADBUSY,PADMY,GMG,SMG,RMG,ROK)
IV = 0
NV = 0
RV = 0x95c2060
PV = 0x95c2060 ""
CUR = 0
LEN = 0
MAGIC = 0x95dfa38
MG_VIRTUAL = 0x28173c
MG_TYPE = PERL_MAGIC_ext(~)
MG_FLAGS = 0x02
REFCOUNTED
MG_OBJ = 0x95c239c
SV = PV(0x95d26bc) at 0x95c239c
REFCNT = 1
FLAGS = ()
PV = 0x95dfbf0 ""
CUR = 0
LEN = 16
Tk::Error: Usage $widget->destroy(...) at ./Tk_carr_docs_check_box.pl line 89.
Tk callback for .frame1.button
Tk::__ANON__ at /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi/Tk.pm line 250
Tk::Button::butUp at /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi/Tk/Button.pm line 175
<ButtonRelease-1>
(command bound to event)
我已经读到这是由于调用destroy引起的，我应该改用packForget()。但是，我无法理解如何用packForget()代替destroy。我尝试了各种方法，例如在$ mw-> packForget()子程序中将'destroy'替换为'packForget'，packForget()，pack->('forget')，但没有一个起作用。有谁知道在这种情况下我可以用packForget代替destroy来看看它是否可以解决我的内存泄漏问题？
要在Linux机器上复制并粘贴此内容。执行时，在第一个窗口对话框中选择“OCP Docs”。然后它将拉出第二个复选框窗口。在第二个窗口中选择任意组合，然后按OK。继续这样做几次，就会发生内存泄漏。只是在debian机器上复制了它。
#!/usr/bin/perl
#####################
sub choose_doc_type {
#####################
use strict;
use Tk;
use Tk::LabFrame;
my $mw = MainWindow->new;
# Mainwindow: sizex/y, positionx/y
$mw->geometry("210x260-0+0");
# Default value
my $doc_type = "";
my $frame = $mw->LabFrame(
-label => "Fax/Doc Type",
-labelside => 'acrosstop',
-width => 180,
-height => 200,
)->place(-x=>10,-y=>10);
# Put these values into the frame
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'RC_SAVE',
-text => 'Docs for RC',
)->place( -x => 10, -y => 5 );
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'OCP_SAVE',
-text => 'OCP Docs',
)->place( -x => 10, -y => 30 );
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'NV_SAVE',
-text => 'New Vendor Docs.',
)->place( -x => 10, -y => 55 );
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'DELETE',
-text => 'Junk. Delete it',
)->place( -x => 10, -y => 80 );
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'NADA',
-text => 'Leave it.',
)->place( -x => 10, -y => 105 );
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'SAVE_FAX',
-text => 'Other - Save it',
)->place( -x => 10, -y => 130 );
$frame->Radiobutton(
-variable => \$doc_type,
-value => 'AP_SAVE',
-text => 'AP Docs',
)->place( -x => 10, -y => 130 );
my $button_frame = $mw->Frame()->pack(-side => "bottom");
my $ok_button = $button_frame->Button(-text => 'OK',
-command => [$mw=>'destroy']
)->pack(-side => "left");
MainLoop;
#print $doc_type . "\n";
#chomp (my $jj = <STDIN>);
return $doc_type;
############################
} # end of sub choose doc type
############################
#####################
sub carr_docs_box {
#####################
my ($c_no) = @_;
use Tk;
use strict;
my $mw = MainWindow->new;
$mw->geometry("180x270-0-30");
$mw->title("Check Button Select");
my @check;
my $doc_string;
$check[1];
$check[2];
$check[3];
$check[4];
$check[5];
$check[6];
$check[7];
$check[8];
$check[9];
my $check_frame = $mw->Frame()->pack(-side => "top");
$check_frame->Label(-text=>"Select Included Documents.")->pack(-side => "top")->pack();
my @chk;
$chk[1] = $check_frame->Checkbutton(-text => 'BC Agrm',
-variable => \$check[1],
-onvalue => '_BCA',
-offvalue => '')->pack();
$chk[2] = $check_frame->Checkbutton(-text => 'Bond',
-variable => \$check[2],
-onvalue => '_ATH',
-offvalue => '')->pack();
$chk[3] = $check_frame->Checkbutton(-text => 'Gen Liab. Insr.',
-variable => \$check[3],
-onvalue => '_INL',
-offvalue => '')->pack();
$chk[4] = $check_frame->Checkbutton(-text => 'Auto Insr.',
-variable => \$check[4],
-onvalue => '_INC',
-offvalue => '')->pack();
$chk[5] = $check_frame->Checkbutton(-text => 'Indp. Contractor',
-variable => \$check[5],
-onvalue => '_IND',
-offvalue => '')->pack();
$chk[6] = $check_frame->Checkbutton(-text => 'Profile',
-variable => \$check[6],
-onvalue => '_PRF',
-offvalue => '')->pack();
$chk[7] = $check_frame->Checkbutton(-text => 'W9 Form',
-variable => \$check[7],
-onvalue => '_W9',
-offvalue => '')->pack();
$chk[8] = $check_frame->Checkbutton(-text => 'Rush Pay Agrm.',
-variable => \$check[8],
-onvalue => '_RP',
-offvalue => '')->pack();
$chk[9] = $check_frame->Checkbutton(-text => 'Other',
-variable => \$check[9],
-onvalue => '_OTH',
-offvalue => '')->pack();
my $button_frame = $mw->Frame()->pack(-side => "bottom");
my $ok_button = $button_frame->Button(-text => 'OK',
-command => \&check_sub)->pack(-side => "left");
# summary sub
sub check_sub {
# check to see if they selected quick Pay
if ($check[8] eq '_RP') { # user says that recvd a Rush Pay agrm
# verify rush pay agrm and set up rush pay
rush_pay_set_up($c_no);
}
$doc_string = join "", @check;
#print "Doc " . $doc_string . "\n";
#chomp (my $TT=<STDIN>);
$mw->destroy;
}
MainLoop;
return $doc_string;
#########
} # end of sub
############
my $dt; # type of documents viewed
my $quit = 'n';
my $test_cno = 1111;
while ($quit ne 'q') {
($dt) = choose_doc_type();
print "quit equals: $quit\n";
if ($dt eq 'OCP_SAVE') { # Classify vendor docs.
my $doc_string = carr_docs_box($test_cno);
print "Doc String would be: " . $doc_string . "\n";
sub { exit; }
}
print "Press (q) to quit Enter to continue any other key to quit.\n";
chomp ($quit = <STDIN>);
}
最佳答案
是的，我现在可以重现您描述的行为。似乎该问题与名为check_sub的内部子项(位于carr_docs_box子项内部)有关:
sub check_sub {
[...]
$mw->destroy; # <-- closure over the `$mw` variable
}
命名内部子程序在编译时存储在全局 namespace 中，请参阅Nested subroutines and Scoping in Perl。因此，当将它们用作外部子句中的词法变量的闭包时，它可能不是您期望的变量。在您的情况下，内部子项中的
$mw在第二次调用中未引用外部子项中的$mw。要解决此问题，您可以在$mw的命令中显式传递正确的$ok_button。所以代替my $ok_button = $button_frame->Button(
-text => 'OK',
-command => \&check_sub)->pack(-side => "left");
你可以做:
my $ok_button = $button_frame->Button(
-text => 'OK',
-command => sub { check_sub( $mw ) })->pack(-side => "left");
另一个选择是首先不要使用命名的内部子对象，这可能会为您和将来的维护者避免一些困惑。这就是我要做的。
另请注意，在Perl 5.18版之后，您可以声明词法子，有关更多信息，请参见
perldoc perlsub 。然后，将check_sub定义为词法(使用my sub check_sub { ... }也会解决闭包问题。关于linux - Perk Tk内存泄漏，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/47394341/