######################### 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; TestLeak(\&NewLeak); TestLeak(\&NewLeak); TestLeak(\&NewLeak2); TestLeak(\&NewLeak2); $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); $StartKey = 1; TestLeak(\&GetLeak); $FC->clear(); $StartKey = 1; TestLeak(\&SetLeak); 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); sub RandStr { return join '', map { chr(ord('a') + rand(26)) } (1 .. $_[0]); } sub TestLeak { my $Sub = 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"); } 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 = (); } }