The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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
}