Perk Tk Memory leak - linux

Question

I have the perl Tk subroutine below that when run repeatedly on some of the Centos 6 machines on our small private LAN get the following error:
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)
I have read that this is caused because destroy is called and that I should use packForget() instead. However, I have not been able to understand how to substitute packForget() for destroy. I have tried various methods such as replacing 'destroy' with 'packForget', packForget(), pack->('forget'), in a subroutine with $mw->packForget() but none has worked. Does anyone know how I can replace destroy with packForget in this case to see if it cures my memory leak problem?
To reproduce this on a linux machine copy and paste. When you execute pick "OCP Docs" at the first window dialog box. It will then pull up a second check box window. At that second window select any combination and press ok. Continue doing this a few times and the memory leak occurs. Just reproduced it on a debian machine.
#!/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

Yes I can now reproduce the behavior you described. Seems like the problem is related to the inner sub named check_sub (located inside the carr_docs_box sub):
sub check_sub {
[...]
$mw->destroy; # <-- closure over the `$mw` variable
}
Named inner subs are stored in a global namespace at compile time, see Nested subroutines and Scoping in Perl. So when they are used as a closure over lexical variables in an outer sub, that might not be the variable that you expect. In your case, the $mw in the inner sub is not referring to the $mw in the outer sub in its second invocation. To fix it, you can pass the correct $mw explicitly in the $ok_button's command. So instead of
my $ok_button = $button_frame->Button(
-text => 'OK',
-command => \&check_sub)->pack(-side => "left");
you can do:
my $ok_button = $button_frame->Button(
-text => 'OK',
-command => sub { check_sub( $mw ) })->pack(-side => "left");
Another option is to not used named inner subs in the first place, this will probably save you and future maintainers some confusion. This is what I would do.
Also note that after Perl version 5.18, you can declare lexical subs, see perldoc perlsub for more information. Then, defining check_sub as lexical (using my sub check_sub { ... } would also solve the problem with closure.