The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

#########################

use Test::More;

BEGIN {
  eval "use GTop ();";
  if ($@) {
    plan skip_all => 'No GTop installed, no memory leak tests';
  } else {
    plan tests => 10;
  }
  use_ok('Cache::FastMmap');
}

use strict;

my $GTop = GTop->new;

#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

our ($DidRead, $DidWrite, $DidDelete, $HitCount);

our $FC;
$FC = Cache::FastMmap->new(init_file => 0, raw_values => 1);
$FC = undef;

TestLeak(\&NewLeak, "new - 1");
TestLeak(\&NewLeak, "new - 2");
TestLeak(\&NewLeak2, "new2 - 1");
TestLeak(\&NewLeak2, "new2 - 2");

$FC = Cache::FastMmap->new(
  init_file => 1,
  raw_values => 1,
  num_pages => 17,
  page_size => 8192,
  read_cb => sub { $DidRead++; return undef; },
  write_cb => sub { $DidWrite++; },
  delete_cb => sub { $DidDelete++; },
  write_action => 'write_back'
);

ok( defined $FC );

# Prefill cache to make sure all pages mapped
for (1 .. 2000) {
  $FC->set(RandStr(15), RandStr(10));
}
$FC->get('foo');

our $Key = "blah100000blah";
our $Val = "\x{263A}" . RandStr(17);

our $StartKey = 1;
TestLeak(\&SetLeak, "set");

$StartKey = 1;
TestLeak(\&GetLeak, "get");

$FC->clear();

$StartKey = 1;
TestLeak(\&SetLeak, "set2");

our (@a, @b, @c);
@a = $FC->get_keys(0);
@b = $FC->get_keys(1);
@c = $FC->get_keys(2);
@a = @b = @c = ();

ListLeak();
TestLeak(\&ListLeak, "list");

sub RandStr {
  return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]);
}

sub TestLeak {
  my $Sub = shift;
  my $Test = shift;

  my $Before = $GTop->proc_mem($$)->size;
  eval {
    $Sub->();
  };
  if ($@) {
    ok(0, "leak test died: $@");
  }
  my $After = $GTop->proc_mem($$)->size;

  my $Extra = ($After - $Before)/1024;
  ok( $Extra < 30, "leak test $Extra > 30k - $Test");
}

sub NewLeak {

  for (1 .. 1000) {
    $FC = Cache::FastMmap->new(
      init_file => 0,
      raw_values => 1,
      num_pages => 17,
      page_size => 8192,
      read_cb => sub { $DidRead++; return undef; },
      write_cb => sub { $DidWrite++; },
      delete_cb => sub { $DidDelete++; },
      write_action => 'write_back'
    );
  }
  $FC = undef;

}

sub NewLeak2 {

  for (1 .. 100) {
    $FC = Cache::FastMmap->new(
      init_file => 1,
      raw_values => 1,
      num_pages => 17,
      page_size => 8192,
      read_cb => sub { $DidRead++; return undef; },
      write_cb => sub { $DidWrite++; },
      delete_cb => sub { $DidDelete++; },
      write_action => 'write_back'
    );
  }
  $FC = undef;

}

sub SetLeak {
  for (1 .. 10000) {
    $Key = "blah" . $StartKey++ . "blah";
    if ($_ < 9000) { $Val = RandStr(int(rand(15))+2); }
    elsif ($_ < 9500) { $Val = "\x{263A}" . RandStr(int(rand(15))+2); }
    else { $Val = undef; }

    $FC->set($Key, $Val);
  }
}

sub GetLeak {
  for (1 .. 20000) {
    $Key = "blah" . $StartKey++ . "blah";
    $HitCount++ if $FC->get($Key);
  }
}

sub WBLeak {
  for (1 .. 5000) {
    $Key = "blah" . $StartKey++ . "blah";
    if ($_ < 4000) { $Val = RandStr(int(rand(15))+2); }
    elsif ($_ < 4500) { $Val = "\x{263A}" . RandStr(int(rand(15))+2); }
    else { $Val = undef; }
    $FC->set($Key, $Val);
    my $PreDidWrite = $DidWrite;
    $FC->empty();
    $PreDidWrite + 1 == $DidWrite
      || die "write count mismatch";
    $FC->get($Key)
      && die "get success";
  }
}

sub ListLeak {
  for (1 .. 100) {
    @a = $FC->get_keys(0);
    @b = $FC->get_keys(1);
    @c = $FC->get_keys(2);
    @a = @b = @c = ();
  }
}