Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Hunting for a memory leak

by perldough (Sexton)
on Aug 07, 2012 at 15:02 UTC ( #986015=perlquestion: print w/ replies, xml ) Need Help??
perldough has asked for the wisdom of the Perl Monks concerning the following question:

I have written a program which leaks approximately 60MBs every time a string of routines runs (starts with &start_problems).

With a debugger and the task manager, I'm pretty sure I have narrowed the source of the leak to $img and $zimg (which contain an image and a zoomed version of the image, respectively), but I'm not having any success eliminating these leaks. Perhaps someone could offer some insight?

How to use the test program:
- Run the test program.
- Wait for "init start" and "init end" to be printed to stdout.
- Make sure the Toplevel (the large window with XXX as the caption) is in focus.
- Press the up arrow key and see "start" appear in stdout.
- Wait until "end" appears in stdout.
- You may then press up again in such a fashion indefinitely (or until the memory leak kills the application).
Note: I used a blank 9134x6059 .png for largeimage.png.
use Tk; use Tk; use Tk::PNG; use Tk::LabFrame; use Tk::Radiobutton; use Tk::Pane; use Tk::WorldCanvas; use strict; our $currdwg = "./largeimage.png"; our $ZC; our $sr; our ($imgX, $imgY); our $MW = MainWindow->new(-title => " PROXY FOR MW"); $MW->geometry("+4+5"); review($MW); MainLoop; sub review { my ($MW) = @_; my ($RW, $CW) = makeReviewScreen($MW); } sub makeReviewScreen { my ($MW) = @_; our $width = $MW->screenwidth - 145; my $RW = $MW->Toplevel(-title => 'XXX'); $RW->geometry("+0+5"); my $LW = $RW->Frame; my $CW = $RW->Scrolled('WorldCanvas', -width => $width, -height => '480', -background => 'white', -borderwidth => '3', -scrollbars => 'se', -relief => 'sunken', -scrollregion => [-100,0, 6000,40 +00]); $ZC = new ZoomCanvas($CW, 1); $LW->pack(-side => 'left', -fill => 'y', -expand => '1', -ancho +r => 'nw', ); $CW->pack(-side => 'left', -fill => 'both', -expand => '1' ); $RW->bind('<Up>' => sub { print "start\n"; start_problems($MW, $ZC); print "end\n"; } ); print "init start\n"; start_problems($MW, $ZC); print "init end\n"; return ( $RW, $CW); } sub start_problems { my ($MW, $ZC) = @_; my @items = $ZC->find('all'); for my $item (@items) { $ZC->delete($item); } show_drawing($MW, $ZC); } sub show_drawing { use GD::Image; use MIME::Base64 qw[ encode_base64 ]; my ($MW, $ZC) = @_; #----------------- Display drawing at specified +- zoom --------- +---------# my $orig = GD::Image->new($currdwg); my ($xMax, $yMax) = $orig->getBounds; $sr = 3500/ $xMax; ($imgX, $imgY) = map { int($_ * $sr) } $orig->getBounds; my $small = GD::Image->new($imgX, $imgY); $small->copyResampled($orig, 0, 0, 0, 0, $imgX, $imgY, $orig->getB +ounds); my $img = $MW->Photo(-data => encode_base64( $small->png ), -format => 'png' ); $MW->configure( -title => " REVIEW INTERLOCKING DRAWING - $currd +wg ($xMax x $yMax)"); my $dwg = $ZC->createImage($MW,0,0, -anchor => 'nw', -image => $im +g, -tags => 'dwg'); $ZC->centerTags($dwg); undef $img; undef $small; undef $orig; return ([$xMax, $yMax],[$imgX, $imgY]); } package ZoomCanvas; use strict; use Tk; use feature 'state'; sub new { my $class = shift; my $canvas = shift; my $zoom = shift; # Quick loose check to ensure $canvas is a WorldCanvas my $test1 = (ref($canvas) eq "Tk::Frame"); use Data::Dumper; my $test2 = (Dumper($canvas) =~ "worldcanvas"); if (! ($test1 && $test2)) { die "ZoomCanvas::new: canvas argument not WorldCanvas!\n" } if (! defined $zoom) { $zoom =1; } my $self = { CANVAS => $canvas, ZOOM => $zoom }; bless $self, $class; return $self; } sub AUTOLOAD { my @args = @_; my $self = shift @args; my $substring = $ZoomCanvas::AUTOLOAD; my @splitSub = split("::", $substring); my $sub = $splitSub[1]; my $canvas = $self->{CANVAS}; return $canvas->$sub(@args); } sub createImage { use Tk::Photo; use Storable; use Storable qw(nstore dclone); # Create state vars state $xoff; state $yoff; state %miscArgs; state $MW; my @args = @_; my $self = shift @args; my $canvas = $self->{CANVAS}; my $MW_tmp = shift @args; # Original args my $xoff_tmp = shift @args; my $yoff_tmp = shift @args; my %miscArgs_tmp = @args; if ( defined $MW_tmp && defined $xoff_tmp && defined $yoff_tmp && (keys %miscArgs_tmp) ) { $MW = $MW_tmp; $xoff = $xoff_tmp; $yoff = $yoff_tmp; if (exists $miscArgs{-image}) { delete $miscArgs{-image}; } %miscArgs = %miscArgs_tmp; } my $img = $miscArgs{-image}; my $zimg = $MW->Photo(); ($self->{ZOOM} > 1) ? $zimg->copy($img, -zoom => $self->{ZOOM +}) : $zimg->copy($img, -subsample => (1 / $self-> +{ZOOM})); $miscArgs{-image} = $zimg; my @miscArgs_list = %miscArgs; my $return = $canvas->createImage($xoff,$yoff, @miscArgs_list); $miscArgs{-image} = $img; delete $miscArgs{-image}; delete $miscArgs_tmp{-image}; undef $img; undef $zimg; return $return; } 1;
Thanks,
Perldough

Comment on Hunting for a memory leak
Download Code
Re: Hunting for a memory leak
by BrowserUk (Pope) on Aug 07, 2012 at 16:20 UTC

    If you comment out show_drawing($MW, $ZC); in makeReviewScreen() the leak goes away. So look in show_drawing()

    If you comment out the Photo:

    my $img = 'fred'; # $MW->Photo( # -data => encode_base64( $small->png ), -format => 'png' # );

    The leak goes away.

    If you replace the -data option with a -file option and load a small image straight off disk, each iteration leaks by approximately the size of the loaded image.

    Conclusion: Tk::Photo doesn't clean up its memory when you undef the Photo object.

    I tried adding $img->blank; before the undef, but it made no difference.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

    The start of some sanity?

      Thank you for this. I believe I need to start doubting the CPAN modules a little more. With your diagnosis, I went to CPAN and found that the bug is already documented.

      However, contrary to your diagnosis, the documentation says that use of the -file option does not cause this behaviour. Maybe there is something here I can use...

      Thanks again,
      Perldough
        contrary to your diagnosis, the documentation says that use of the -file option does not cause this behaviour.

        Hm. Here are my findings using the -file option:

        [18:25:56.31] C:\test>dir test.png 26/05/2012 11:30 7,133 test.png [18:26:17.25] C:\test>986015.pl start perl.exe 6476 Console 1 29 +,328 K end start perl.exe 6476 Console 1 34 +,652 K end start perl.exe 6476 Console 1 38 +,348 K end start perl.exe 6476 Console 1 38 +,180 K end start perl.exe 6476 Console 1 39 +,324 K end start perl.exe 6476 Console 1 42 +,816 K end start perl.exe 6476 Console 1 45 +,948 K end

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        The start of some sanity?

        Looking in the POD for Tk::Image it says:

        CAVEATS It's necessary to use the "delete" method to delete an image object and free memory associated with it. Just using a lexical variable for storing the image object and letting the variable to go out of scope or setting to undef is not sufficient.

        That said, I tried adding

        $ZC->centerTags($dwg); $img->delete; undef $img;

        And it made no difference.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        The start of some sanity?

        Thank you for this. I believe I need to start doubting the CPAN modules a little more.

        Tk modules are notorious for leaks -- also , if the module builds any kind of tree, and grepping the source for "weak" returns no hits, 97/100 its leaking :)

Re: Hunting for a memory leak
by zentara (Archbishop) on Aug 07, 2012 at 18:34 UTC
    Reuse Photo objects, by blanking them and loading another image. Also you may want to reuse your toplevel window too. See Re: Tk::Gauge errors. Undef'ing them in a subroutine closure will not always work.

    Toplevels and Photo objects leak memory, and need to be reused, instead of a create/destroy cycle, when called often in a script. See Re^2: Tk and ImageMagick


    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      This solved it: no more memory leaks at all.

      Here is my modified code for posteriority:

      use Tk; use Tk; use Tk::PNG; use Tk::LabFrame; use Tk::Radiobutton; use Tk::Pane; use Tk::WorldCanvas; use strict; use feature 'state'; our $currdwg = "./largeimage.png"; our $ZC; our $sr; our ($imgX, $imgY); our $MW = MainWindow->new(-title => " PROXY FOR MW"); $MW->geometry("+4+5"); review($MW); MainLoop; sub review { my ($MW) = @_; my ($RW, $CW) = makeReviewScreen($MW); } sub makeReviewScreen { my ($MW) = @_; our $width = $MW->screenwidth - 145; my $RW = $MW->Toplevel(-title => 'XXX'); $RW->geometry("+0+5"); my $LW = $RW->Frame; my $CW = $RW->Scrolled('WorldCanvas', -width => $width, -height => '480', -background => 'white', -borderwidth => '3', -scrollbars => 'se', -relief => 'sunken', -scrollregion => [-100,0, 6000,40 +00]); $ZC = new ZoomCanvas($CW, 1); $LW->pack(-side => 'left', -fill => 'y', -expand => '1', -ancho +r => 'nw', ); $CW->pack(-side => 'left', -fill => 'both', -expand => '1' ); $RW->bind('<Up>' => sub { print "start\n"; start_problems($MW, $ZC); print "end\n"; } ); print "init start\n"; start_problems($MW, $ZC); print "init end\n"; return ( $RW, $CW); } sub start_problems { my ($MW, $ZC) = @_; my @items = $ZC->find('all'); for my $item (@items) { $ZC->delete($item); } show_drawing($MW, $ZC); } sub show_drawing { use GD::Image; use MIME::Base64 qw[ encode_base64 ]; my ($MW, $ZC) = @_; #----------------- Display drawing at specified +- zoom --------- +---------# my $orig = GD::Image->new($currdwg); my ($xMax, $yMax) = $orig->getBounds; $sr = 3500/ $xMax; ($imgX, $imgY) = map { int($_ * $sr) } $orig->getBounds; my $small = GD::Image->new($imgX, $imgY); $small->copyResampled($orig, 0, 0, 0, 0, $imgX, $imgY, $orig->getB +ounds); # Make sure $img doesn't get released. # Only define new object the first time around. state $img; if (! defined $img) { $img = $MW->Photo(); } # Modify existing object. $img->configure("-format", "png"); $img->configure("-data", encode_base64( $small->png )); # Don't define new object every time. #my $img = $Tk->{MW}->Photo(-data => encode_base64( $small->png ), # -format => 'png' # ); $MW->configure( -title => " REVIEW INTERLOCKING DRAWING - $currd +wg ($xMax x $yMax)"); my $dwg = $ZC->createImage($MW,0,0, -anchor => 'nw', -image => $im +g, -tags => 'dwg'); $ZC->centerTags($dwg); undef $small; undef $orig; # Don't delete $img; keep it for next time. #undef $img; return ([$xMax, $yMax],[$imgX, $imgY]); } package ZoomCanvas; use strict; use Tk; use feature 'state'; sub new { my $class = shift; my $canvas = shift; my $zoom = shift; # Quick loose check to ensure $canvas is a WorldCanvas my $test1 = (ref($canvas) eq "Tk::Frame"); use Data::Dumper; my $test2 = (Dumper($canvas) =~ "worldcanvas"); if (! ($test1 && $test2)) { die "ZoomCanvas::new: canvas argument not WorldCanvas!\n" } if (! defined $zoom) { $zoom =1; } my $self = { CANVAS => $canvas, ZOOM => $zoom }; bless $self, $class; return $self; } sub AUTOLOAD { my @args = @_; my $self = shift @args; my $substring = $ZoomCanvas::AUTOLOAD; my @splitSub = split("::", $substring); my $sub = $splitSub[1]; my $canvas = $self->{CANVAS}; return $canvas->$sub(@args); } sub createImage { use Tk::Photo; use Storable; use Storable qw(nstore dclone); # Create state vars state $xoff; state $yoff; state %miscArgs; state $MW; my @args = @_; my $self = shift @args; my $canvas = $self->{CANVAS}; my $MW_tmp = shift @args; # Original args my $xoff_tmp = shift @args; my $yoff_tmp = shift @args; my %miscArgs_tmp = @args; if ( defined $MW_tmp && defined $xoff_tmp && defined $yoff_tmp && (keys %miscArgs_tmp) ) { $MW = $MW_tmp; $xoff = $xoff_tmp; $yoff = $yoff_tmp; if (exists $miscArgs{-image}) { delete $miscArgs{-image}; } %miscArgs = %miscArgs_tmp; } my $img = $miscArgs{-image}; # Make sure $zimg doesn't get released # Only define new object the first time around state $zimg; if (! defined $zimg) { $zimg = $MW->Photo(); } #my $zimg = $MW->Photo(); ($self->{ZOOM} > 1) ? $zimg->copy($img, -zoom => $self->{ZOOM +}) : $zimg->copy($img, -subsample => (1 / $self-> +{ZOOM})); $miscArgs{-image} = $zimg; my @miscArgs_list = %miscArgs; my $return = $canvas->createImage($xoff,$yoff, @miscArgs_list); $miscArgs{-image} = $img; delete $miscArgs{-image}; delete $miscArgs_tmp{-image}; # Don't delete; keep them for later #undef $img; #undef $zimg; return $return; } 1;
      Thanks everyone,
      Perldough
        That's a nice use of state to avoid the global variable. :-)
        # Make sure $img doesn't get released. # Only define new object the first time around. state $img; if (! defined $img) { $img = $MW->Photo(); }

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
Re: Hunting for a memory leak
by sundialsvc4 (Abbot) on Aug 08, 2012 at 03:06 UTC

    That is quite the bit of entirely-gratuitous “sleuthing” that you have done in order to solve this problem, BrowserUK.   And thoroughly well-done it was, too.   There are not too many web-sites out there where this sort of thing would be de rigueur, let alone for it all to have been done within just a few hours of the original post.   Very impressive.   Thank you.

      Browseruk is the pope around here :D.
      That is quite the bit of entirely-gratuitous “sleuthing” that you have done in order to solve this problem,

      Arg! Actually, it wasn't that much; and it wasn't gratuitous. About 15 minutes effort total spread over the periods of inane pundit chatter between the events at the velodrome.

      And the reason it was so simple is that the OP did all the right things:

      1. Provided self-contained code that ran straight out of the download.
      2. He provided clear instructions on how to run it to demonstrate the problem.
      3. He'd obviously cut it down considerably just for the purpose of posting.

      That, combined with the clear, simply-structured code, made it easy to comment out one or two lines here or there to isolate where in the code the problem lay. And that is the essence of debugging -- finding the bug. After that it is just reasoning.

      It is also where all the "let's hide the complexity behind yet another layer of abstraction" crowd fall flat on their faces. Their attempts to make things look simple, is their undoing when it comes to trying to track through that hidden complexity. Looks simple is not the same as is simple. And every layer of abstraction adds complexity, and removes none.


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      The start of some sanity?

        Thanks for the feedback and for your all your efforts!

        Most gratefully,
        Perldough

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://986015]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2014-09-21 07:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (167 votes), past polls