#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper qw(Dumper);
use English qw(-no_match_vars);
use Test::More;
use Net::RawIP;
plan skip_all => "Proc::ProcessTable is needed for this test"
unless eval "use Proc::ProcessTable; 1";
plan skip_all => "Proc::ProcessTable does not support the size attribute on this platform"
unless eval { my $s = get_process_size($$) };
plan tests => my $tests;
diag "Testing Net::RawIP v$Net::RawIP::VERSION";
# one can run this test giving a number on the command line
# 10,000 seems to be reasonable
my $count = shift || 10_000;
do_something();
my $start_size = get_process_size($$);
diag "Testing memory leak, running $count times";
diag "Start size: $start_size";
for (2..$count) {
do_something();
}
sub do_something {
my $n = Net::RawIP->new({ udp => {} });
$n->set({
ip => {
saddr => 1,
daddr => 2,
},
udp => {
source => 0,
dest => 100,
data => 'payload',
},
});
}
my $end_size = get_process_size($$);
my $size_change = $end_size - $start_size;
diag "End size: $end_size";
diag "Size change was: $size_change";
cmp_ok($size_change, '<', 200_000,
'normally it should be 0 but we are satisfied with 200,000 here, see comments in test file');
BEGIN { $tests += 1; }
# Once upon a time there was a memory leak on Solaris created by the above
# loop.
#
# In order to test the fix I created this test.
# On my development Ubuntu GNU/Linux machine the
# starting size was around 7,300,000 bytes
# while the size change was constantly 1,064,960
# no matter if I ran the loop 1000 times or 1,000,000 times
# (though the latter took 5 minutes...)
# On another Linux machine (same OS, different HW) the change was 1,167,360
# On a Sun Solaris it was 1,220,608 (for 100, 1000, 10,000 and 100,000)
# I guess this the memory footprint of the external libraries that are loaded
# during run time and there is no memory leek.
# In order to reduce the external libraries issue I have changed the test.
# The first memory measurement is now done after calling the loop once
# This way the difference was only 122,880 on the Linux machine.
# I still cannot explain this change
# If you want, you can run the same test with different nuber of times:
# perl -Iblib/lib -Iblib/arch t/memory_leak.t 1000000
sub get_process_size {
my ($pid) = @_;
my $pt = Proc::ProcessTable->new;
foreach my $p ( @{$pt->table} ) {
return $p->size if $pid == $p->pid;
}
return
}