40_abs_cache.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# Unit tests for abstract cache implementation
#
# Test the following methods:
# * new()
# * is_empty()
# * empty()
# * lookup(key)
# * remove(key)
# * insert(key,val)
# * update(key,val)
# * rekey(okeys,nkeys)
# * expire()
# * keys()
# * bytes()
# DESTROY()
#
# 20020327 You somehow managed to miss:
# * reduce_size_to(bytes)
#
# print "1..0\n"; exit;
print "1..42\n";
my ($N, @R, $Q, $ar) = (1);
print "ok $N\n";
$N++;
print "ok $N\n";
$N++;
# (3) Are all the methods there?
{
my $good = 1;
$good = 0;
}
}
$N++;
}
# (4-5) Straight insert and removal FIFO test
$ar = 'a0';
for (1..10) {
}
1;
for (1..10) {
}
? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
$N++;
check($h);
# (6-7) Remove from empty heap
$n = $h->expire;
$N++;
check($h);
# (8-9) Interleaved insert and removal
$Q = 0;
@R = ();
for my $i (1..4) {
for my $j (1..$i) {
$Q++;
}
for my $j (1..$i) {
}
}
$N++;
check($h);
# (10) It should be empty now
$N++;
# (11-12) Insert and delete
$Q = 1;
for (1..10) {
$Q++;
}
for (2, 4, 6, 8, 10) {
}
@R = ();
"ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n";
$N++;
check($h);
# (13-14) Interleaved insert and delete
@R = ();
for my $i (1..4) {
for my $j (1..$i) {
$Q++;
}
for my $j (1..$i) {
$QQ++;
}
}
"ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n";
$N++;
check($h);
# (15-16) Promote
$h->empty;
$Q = 1;
for (1..10) {
}
$Q++;
}
1;
for (2, 4, 6, 8, 10) {
}
@R = ();
"ok $N\n" :
"not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n";
$N++;
check($h);
# (17-22) Lookup
$Q = 1;
for (1..10) {
$Q++;
}
1;
for (2, 4, 6, 4, 8) {
$N++;
}
check($h);
# (23) It shouldn't be empty
$N++;
# (24-25) Lookup should have promoted the looked-up records
@R = ();
"ok $N\n" :
"not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n";
$N++;
check($h);
# (26-29) Typical 'rekey' operation
$Q = 1;
for (1..10) {
$Q++;
}
$h->rekey([6,7,8,9,10], [8,9,10,11,12]);
{
my $good = 1;
print "# looked up $k, got $v, expected $x{$k}\n";
$good = 0;
}
}
$N++;
}
check($h);
{
my $good = 1;
for my $k (6, 7) {
print "# looked up $k, got $v, should have been undef\n";
$good = 0;
}
}
$N++;
}
check($h);
# (30-31) ckeys
"ok $N\n" :
"not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n";
$N++;
1;
# (32-33) update
for (1..5, 8..12) {
}
@R = ();
}
"ok $N\n" :
"not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n";
$N++;
# (34-37) bytes
my $B;
$B = $h->bytes;
print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
$N++;
$B = $h->bytes;
print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
$N++;
# (38-41) empty
$h->empty;
$N++;
$n = $h->expire;
$N++;
# (42) very weak testing of DESTROY
undef $h;
# are we still alive?
print "ok $N\n";
$N++;
sub check {
my $h = shift;
$N++;
}
sub iota {
my ($p, $n) = @_;
my $r;
my $i = 0;
while ($i <= $n) {
$r .= "$p$i ";
$i++;
}
chop $r;
$r;
}