[Catalyst-dev] Need help debugging Text::ASCIITable

Andy Grundman andy at hybridized.org
Mon Sep 26 16:33:56 CEST 2005


I've been trying to fix the leak in T::A but I'm totally stumped, and so 
is the author.  If anyone wants to take a crack at it, I've attached my 
test script.

Run it from the module source directory as: perl -Iblib/lib t/12_leak.t

1..3
Initial memory use: 5345280
Final memory use: 8048640
not ok 1 - no memory leaks
#     Failed test (t/12_leak.t at line 24)
#          got: '8048640'
#     expected: '5345280'
Initial memory use: 8048640
Final memory use: 8048640
ok 2 - no memory leaks
Initial memory use: 8048640
Final memory use: 8048640
ok 3 - no memory leaks
# Looks like you failed 1 tests of 3.

-Andy
-------------- next part --------------
#!perl

use strict;
use warnings;

use Test::More tests => 3;
use Text::ASCIITable;
use GTop;
use Scalar::Util qw(weaken);
my $gtop = GTop->new;

{
    my $t = Text::ASCIITable->new;    
    my $initial = $gtop->proc_mem($$)->size;
    warn "Initial memory use: $initial\n";
    
    for ( 1..1000 ) {
        my $x = Text::ASCIITable->new;
        # should go out of scope...
    }
    
    my $final = $gtop->proc_mem($$)->size;
    warn "Final memory use: $final\n";
    is( $final, $initial, 'no memory leaks' );
}

# test with undef'ing the tiedarr
{
    my $t = Text::ASCIITable->new;    
    my $initial = $gtop->proc_mem($$)->size;
    warn "Initial memory use: $initial\n";
    
    for ( 1..1000 ) {
        my $x = Text::ASCIITable->new;
        undef $x->{tiedarr};
    }
    
    my $final = $gtop->proc_mem($$)->size;
    warn "Final memory use: $final\n";
    is( $final, $initial, 'no memory leaks' );
}

# test with weaken
{
    my $t = Text::ASCIITable->new;    
    my $initial = $gtop->proc_mem($$)->size;
    warn "Initial memory use: $initial\n";
    
    for ( 1..1000 ) {
        my $x = Text::ASCIITable->new;
        weaken( $x->{tiedarr} );
    }
    
    my $final = $gtop->proc_mem($$)->size;
    warn "Final memory use: $final\n";
    is( $final, $initial, 'no memory leaks' );
}


More information about the Catalyst-dev mailing list