我有下面的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。我已经尝试了各种方法，例如用'mt-＆gt; packForget（）在子程序中用'packForget'，packForget（），pack-＆gt;（'forget'）替换'destroy'但没有一种方法有效。有没有人知道如何在这种情况下用packForget替换destroy以查看它是否能解决我的内存泄漏问题？
要在linux机器上复制和粘贴这个。在第一个窗口对话框中执行选择“OCP Docs”时。然后它将拉出第二个复选框窗口。在第二个窗口中选择任意组合，然后按确定。继续这样做几次并发生内存泄漏。只需在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>);
}
答案 0 :(得分：1)
是的，我现在可以重现您描述的行为。似乎问题与名为check_sub的内部子（位于carr_docs_box子内）有关：
sub check_sub {
[...]
$mw->destroy; # <-- closure over the `$mw` variable
}
命名的内部subs在编译时存储在全局命名空间中，请参阅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 { ... }也可以解决闭包问题。