Perk Tk Memory leak

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>);


}

Please lay out your code properly so that we can read it. It helps a lot to avoid tab characters. — Borodin, Nov 20 '17 at 18:11
I can't find any reference to `packetForget` on the internet; certainly not in the `Tk` library. Where did you find this advice? — Borodin, Nov 20 '17 at 18:17
You have to call. $widget->packForget() to "unrealize" your widget, instead of packetForget() — ulix, Nov 20 '17 at 18:23
I meant packForget() it does not work. [$mw=>'packForget'] does nothing (the window does not close. — gatorreina, Nov 20 '17 at 18:30
The packForget() if i remember right is for widget within a window. For the main window or other toplevel see the metod withdraw() — ulix, Nov 20 '17 at 18:35
I tested your code, and it works fine here (Ubuntu 17.04, perl version 5.26.1, Tk version 804.034) — Håkon Hægland, Nov 20 '17 at 20:34
@HåkonHægland To make it so that you can reproduce the error I would need to post more code. Do you know if there is a way for me to edit and add to my original post? — gatorreina, Nov 21 '17 at 14:30
@gatorreina Yes you can add to or update your question by clicking the "edit" button below it.. — Håkon Hægland, Nov 21 '17 at 14:34
@HåkonHægland 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. — gatorreina, Nov 21 '17 at 14:51

Håkon Hægland · Accepted Answer · 2017-11-21T19:38:54.680

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.

edited Nov 21 '17 at 19:38

answered Nov 21 '17 at 19:11

Håkon Hægland

39,012
21
81
174

Thanks for the reply. Unfortunately, I get the same result and error message with -command => sub { check_sub( $mw ) })->pack(-side => "left"); Not sure how I can make it work without the named inner sub, but will try to figure it out. – gatorreina Nov 21 '17 at 21:22
Note that you must also modify `check_sub` to unpack the passed `$mw` argument. In the beginning of `check_sub` you do `my ($mw) = @_` to overwrite the closure of `$mw`. – Håkon Hægland Nov 22 '17 at 05:13
Thank you. That indeed stopped the error on the subsequent executions. However, the $doc_string scalar does not get passed (returned) after the first time -- which is kinda of the whole point of the code -- any idea why? – gatorreina Nov 22 '17 at 15:15
@gatorreina Great! Now I would suggest you also pass a reference to `$doc_string` to `check_sub()` for the same reasons as before: to get the correct version of the variable. [Here](https://pastebin.com/yEZZgDH0) is an example that worked for me. – Håkon Hægland Nov 22 '17 at 16:46
Your solution worked. Thank you very much for the help. – gatorreina Nov 26 '17 at 02:25

Perk Tk Memory leak

1 Answers1