Trying to trace a memory leak - I think...

["Matthew Braid" <ptkperl mdb id au>]

Hi all,

I'm creating a GUI that includes the ability to add or remove
'sections' of text. I'm using Glade, so each section is created on the
fly by loading a section of the Glade spec and pulling widgets out of
it. I keep track of the glade objects and the callback objects they
refer to, and when a section is deleted those section widgets are
destroyed. Note that I have to use a Table  to add section parts into
rather than a VBox because the right hand side of each section has to
line up with a widget (in the test case below a Label) exactly. In the
real code this widget is a character-marked ruler.

Unfortunately, while it works nicely as far as the user is concerned,
it seems a little bit of memory is leaking when a section is deleted.

I've attached the Glade XML file for a test case, and below is the
driving code. If you run it and then hit the 'add' button 5 times, the
memory usage goes up as expected. If you then delete all 5 and hit add
another 5 times, memory usage goes up again - in smaller steps than
the first time.

I was expecting that if you created X sections you could delete/add to
your heart's content and as long as the section count never exceeded X
you'd never use more memory.

Am I incorrect in this assumption or am I forgetting something in my code?

TIA,

MB

----- START CODE -----
use strict;
use Gtk2 -init;
use Gtk2::GladeXML;

my $GLADE_FILE = '/path/to/test.glade';
my @sections;
my $MGLADE;

{
package SECTIONCALLBACKS;
sub new { bless({}) }

sub delete {
  my $self = shift;
  my $i = $self->_find_pos;
  return if not defined $i;
  my $tbl = $MGLADE->get_widget('SectionBox');
  # Do some extra destroying - not sure if this is entirely necessary
  my $sect = $sections[$i];
  for my $child ($sect->[0]->get_widget('SectionLeft')->get_children,
                 $sect->[0]->get_widget('SectionRight')->get_children) {
    $child->destroy;
  }
  $tbl->remove($sect->[0]->get_widget('SectionLeft'));
  $tbl->remove($sect->[0]->get_widget('SectionRight'));
  $sect->[0]->DESTROY;
  # Remove this entry from @sections
  splice(@sections, $i, 1);
  # Re-pack subsequent items so no gaps in table...
  for my $j ($i..scalar(@sections) - 1) {
    my ($l, $r) =
      ($sections[$j][0]->get_widget('SectionLeft'),
       $sections[$j][0]->get_widget('SectionRight'));
    $tbl->remove($l);
    $tbl->remove($r);
    $tbl->attach($l, 0, 1, $j + 1, $j + 2, [qw/fill/], [qw/fill/], 0, 0);
    $tbl->attach($r, 1, 2, $j + 1, $j + 2, [qw/fill expand/],
                 [qw/fill expand/], 0, 0);
  }
}

sub _find_pos {
  my $self = shift;
  for my $i (0..scalar(@sections) - 1) {
    return $i if $sections[$i][1] eq $self;
  }
  return undef;
}
}

{
 package MAINCALLBACKS;
 sub new { bless({}) }

 sub add {
   my $self = shift;
   my $nglade = Gtk2::GladeXML->new($GLADE_FILE, 'SectionTable');
   my $ncb = SECTIONCALLBACKS->new;
   $nglade->signal_autoconnect_from_package($ncb);
   my $tab = $MGLADE->get_widget('SectionBox');
   my ($oldparent, $left, $right) = ($nglade->get_widget('SectionTable'),
                                     $nglade->get_widget('SectionLeft'),
                                     $nglade->get_widget('SectionRight'));
   $oldparent->remove($left);
   $oldparent->remove($right);
   $oldparent->destroy;
   my $top = scalar(@sections) + 1; # Plus one due to the header label
   $tab->attach($left, 0, 1, $top, $top + 1, [qw/fill/], [qw/fill/], 0, 0);
   $tab->attach($right, 1, 2, $top, $top + 1,
                [qw/fill expand/], [qw/fill expand/], 0, 0);
   push @sections, [$nglade, $ncb];
 }

 sub quit { exit }
}

$MGLADE = Gtk2::GladeXML->new($GLADE_FILE, 'MainWindow');
$MGLADE->signal_autoconnect_from_package(MAINCALLBACKS->new);
Gtk2->main;

Attachment: test.glade
Description: Binary data