Perk Tk 内存泄漏

Question

我有下面的 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。我尝试了各种方法，例如用 'packForget'、packForget()、pack->('forget') 替换 'destroy'，在子例程中使用 $mw->packForget() 但 none 有效。有谁知道在这种情况下我如何用 packForget 替换 destroy 以查看它是否可以解决我的内存泄漏问题？

要在 linux 机器上复制并粘贴。当你在第一个 window 对话框执行 pick "OCP Docs" 时。然后它将拉出第二个复选框 window。在那一秒 window select 任何组合，然后按确定。继续这样做几次，就会发生内存泄漏。刚刚在 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>);


}

Answer 1

是的，我现在可以重现您描述的行为。似乎问题与名为 check_sub 的内部子项（位于 carr_docs_box 子项内）有关：

sub check_sub {
    [...]

    $mw->destroy;  # <-- closure over the `$mw` variable
}

命名的内部子程序在编译时存储在全局命名空间中，请参阅 Nested subroutines and Scoping in Perl。因此，当它们用作外部 sub 中词法变量的闭包时，它可能不是您期望的变量。在您的情况下，内部 sub 中的 $mw 在其第二次调用中未引用外部 sub 中的 $mw 。要修复它，您可以在 $ok_button 的命令中明确传递正确的 $mw。所以而不是

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 { ... } 也可以解决闭包问题。

Perk Tk 内存泄漏

Perk Tk Memory leak

linux

perl

memory-leaks

tk