4
# This code tests for a set of memory leaks that were present in the simple
5
# decoder. Its really crude, but should show up major issues...
12
plan skip_all => "This tests is for release candidate testing" unless ( $ENV{AUTHOR_TESTING} );
14
eval "use Unix::Getrusage";
15
plan skip_all => "Unix::Getrusage required for testing memory leakiness" if $@;
18
use_ok('Unix::Getrusage');
20
no strict "subs"; # getrusage triggers this...
22
# Build an XML document, reasonable size, combination of hash and arrays
23
my $numbers = join( '', ( map {"<number>$_</number>"} 0 .. 100 ) );
24
my $xmldoc = join( '', '<document>', ( map {"<$_>$numbers</$_>"} 'a' .. 'z' ), '</document>' );
26
my $obj = XML::Bare->new( text => $xmldoc );
27
my $hash = $obj->simple;
29
ok( $hash, 'First conversion XML -> hash' );
30
undef($hash); # force release
33
my $final_stats = Unix::Getrusage::getrusage(); # preusing memory
34
my $initial_stats = Unix::Getrusage::getrusage();
35
ok( $initial_stats, 'Got process stats' );
37
foreach my $codepath ( 'simple', 'parse' ) {
39
# now loop over conversion
40
while ( $count++ < 500 ) {
41
$obj = XML::Bare->new( text => $xmldoc );
42
$hash = $obj->$codepath;
43
undef($hash); # force release
46
ok( 1, "Completed test loop for $codepath" );
48
$final_stats = Unix::Getrusage::getrusage();
49
ok( $final_stats, "Got process stats" );
51
my $is_slim = ( ( $initial_stats->{ru_maxrss} * 2 ) > $final_stats->{ru_maxrss} ) ? 1 : 0;
52
ok( $is_slim, "Process has not bloated on $codepath codepath" );
55
diag( "Initial: " . $initial_stats->{ru_maxrss} );
56
diag( "Final: " . $final_stats->{ru_maxrss} );