#!/usr/local/bin/perl -w
use lib '/home/mod_perl/hm/modules';
use ExtUtils::testlib;
use Cache::FastMmap;
use Data::Dumper;
use POSIX ":sys_wait_h";
use strict;
#EdgeTests();
my $FC = Cache::FastMmap->new(
init_file => 1,
raw_values => 1
) || die "Could not create file cache";
BasicTests($FC);
$FC->clear();
my @Keys;
RepeatMixTest($FC, 0.0, \@Keys);
RepeatMixTest($FC, 0.5, \@Keys);
RepeatMixTest($FC, 0.8, \@Keys);
ForkTests($FC);
$FC = Cache::FastMmap->new(
init_file => 1,
page_size => 8192,
raw_values => 1
) || die "Could not create file cache";
BasicTests($FC);
$FC->clear();
@Keys = ();
RepeatMixTest($FC, 0.0, \@Keys);
RepeatMixTest($FC, 0.5, \@Keys);
RepeatMixTest($FC, 0.8, \@Keys);
ForkTests($FC);
print "All done\n";
exit(0);
sub BasicTests {
my $FC = shift;
printf "Basic tests\n";
# Test empty
!defined $FC->get('')
|| die "Not undef on empty get";
!defined $FC->get(' ')
|| die "Not undef on empty get";
!defined $FC->get(' ' x 1024)
|| die "Not undef on empty get";
!defined $FC->get(' ' x 65536)
|| die "Not undef on empty get";
# Test basic store/get on key sizes
$FC->set('', 'abc');
$FC->get('') eq 'abc'
|| die "Get mismatch";
$FC->set(' ', 'def');
$FC->get(' ') eq 'def'
|| die "Get mismatch";
$FC->set(' ' x 1024, 'ghi');
$FC->get(' ' x 1024) eq 'ghi'
|| die "Get mismatch";
# Bigger than the page size - shouldn't work
$FC->set(' ' x 65536, 'jkl');
!defined $FC->get(' ' x 65536)
|| die "Get mismatch";
# Test basic store/get on value sizes
$FC->set('abc', '');
$FC->get('abc') eq ''
|| die "Get mismatch";
$FC->set('def', 'x');
$FC->get('def') eq 'x'
|| die "Get mismatch";
$FC->set('ghi', 'x' . ('y' x 1024) . 'z');
$FC->get('ghi') eq 'x' . ('y' x 1024) . 'z'
|| die "Get mismatch";
# Bigger than the page size - shouldn't work
$FC->set('jkl', 'x' . ('y' x 65536) . 'z');
!defined $FC->get('jkl')
|| die "Get mismatch";
# Ref key should use 'stringy' version
my $Ref = [ ];
$FC->set($Ref, 'abcd');
$FC->get($Ref) eq 'abcd'
|| die "Get mismatch";
$FC->get("$Ref") eq 'abcd'
|| die "Get mismatch";
# Check utf8
# eval { $FC->set("\x{263A}", "blah\x{263A}"); };
# $@ || die "Set utf8 succeeded, but should have failed: $@";
# eval { $FC->set("blah", "\x{263A}"); };
# $@ || die "Set utf8 succeeded, but should have failed: $@";
# eval { $FC->get("\x{263A}"); };
# $@ || die "Set utf8 succeeded, but should have failed: $@";
$FC->set("\x{263A}", "blah\x{263A}");
$FC->get("\x{263A}") eq "blah\x{263A}"
|| die "Get mismatch";
$FC->clear();
$FC->set("abc", "123");
$FC->set("bcd", "234");
$FC->set("cde", "345");
$FC->set("def", "456");
join(",", sort $FC->get_keys) eq "abc,bcd,cde,def"
|| die "get_keys mismatch";
$FC->set("efg\x{263A}", "567\x{263A}");
join(",", sort $FC->get_keys) eq "abc,bcd,cde,def,efg\x{263A}"
|| die "get_keys mismatch";
my %keys = map { $_->{key} => $_ } $FC->get_keys(2);
$keys{abc}->{value} eq "123"
|| die "get_keys missing";
$keys{"efg\x{263A}"}->{value} eq "567\x{263A}"
|| die "get_keys missing";
}
sub EdgeTests {
my $FC = Cache::FastMmap->new(
init_file => 1,
num_pages => 1,
raw_values => 1
) || die "Could not create file cache";
printf "Edge tests. Assume implementation\n";
$FC->clear();
# bytes for kv data
# 65536 - 8*4 - 4*4*89 = 64080
# adds 4*2 + 1 + 1 = 10 bytes, 64070 rem
$FC->set('a', 'a');
$FC->get('a') eq 'a'
|| die "Get mismatch";
# Ensure oldest timestamp
sleep 2;
# adds 4*2 + 1 + 64051 = 64060, 10 rem
$FC->set('b', 'b' x 64051);
$FC->get('b') eq 'b' x 64051
|| die "Get mismatch";
sleep 2;
# adds 4*2 + 1 + 1 = 10 bytes, 0 rem
$FC->set('c', 'c');
$FC->get('c') eq 'c'
|| die "Get mismatch";
$FC->get('b') eq 'b' x 64051
|| die "Get mismatch";
$FC->get('a') eq 'a'
|| die "Get mismatch";
# adds 4*2 + 1 + 1 = 10 bytes, force expunge
$FC->set('d', 'd');
!defined $FC->get('a')
|| die "Get mismatch";
!defined $FC->get('b')
|| die "Get mismatch";
$FC->get('d') eq 'd'
|| die "Get mismatch";
$FC->get('c') eq 'c'
|| die "Get mismatch";
# Try again
$FC->clear();
# adds 4*2 + 1 + 1 = 10 bytes, 64070 rem
$FC->set('a', 'a');
$FC->get('a') eq 'a'
|| die "Get mismatch";
# Ensure oldest timestamp
sleep 2;
# adds 4*2 + 1 + 64052 = 64061, 9 rem
$FC->set('b', 'b' x 64052);
$FC->get('b') eq 'b' x 64052
|| die "Get mismatch";
sleep 2;
# adds 4*2 + 1 + 1 = 10 bytes, -1 rem, force expunge
$FC->set('c', 'c');
$FC->get('c') eq 'c'
|| die "Get mismatch";
!defined $FC->get('b')
|| die "Get mismatch";
!defined $FC->get('a')
|| die "Get mismatch";
# adds 4*2 + 1 + 1 = 10 bytes
$FC->set('d', 'd');
$FC->get('d') eq 'd'
|| die "Get mismatch";
$FC->get('c') eq 'c'
|| die "Get mismatch";
}
sub ForkTests {
# Now fork several children to test cache concurrency
my ($Pid, %Kids);
for (my $j = 0; $j < 8; $j++) {
if (!($Pid = fork())) {
RepeatMixTest($FC, 0.4, \@Keys);
exit;
}
$Kids{$Pid} = 1;
select(undef, undef, undef, 0.001);
}
# Wait for children to finish
my $Kid;
do {
$Kid = waitpid(-1, WNOHANG);
delete $Kids{$Kid};
} until $Kid > 0 && !%Kids;
}
sub RepeatMixTest {
my ($FC, $Ratio, $WroteKeys) = @_;
print "Repeat mix tests\n";
my ($Read, $ReadHit);
# Lots of random tests
for (1 .. 10000) {
# Read/write ratio
if (rand() < $Ratio) {
# Pick a key from known written ones
my $K = $WroteKeys->[ rand(@$WroteKeys) ];
my $V = $FC->get($K);
$Read++;
# Skip if not found in cache
next if !defined $V;
$ReadHit++;
# Offset of 10 past first chars of value are key
substr($V, 10, length($K)) eq $K
|| die "Cache/key not equal: $K, $V";
} else {
my $K = RandStr(16);
my $V = RandStr(10) . $K . RandStr(int(rand(200)));
push @$WroteKeys, $K;
$FC->set($K, $V);
}
}
printf "Read hit pct: %5.3f\n", ($ReadHit/$Read) if $Read;
return;
}
sub RandStr {
my $Len = shift;
if (!$::URandom) {
open($::URandom, '/dev/urandom')
|| die "Could not open /dev/urandom: $!";
}
sysread($::URandom, my $D, $Len);
$D =~ s/(.)/chr(ord($1) % 26 + ord('a'))/ge;
return $D;
}