package testcases::Cache; use strict; use XAO::SimpleHash; use XAO::Utils; use XAO::Cache; use base qw(testcases::base); sub test_everything { my $self=shift; my $count=0; my $cache=XAO::Cache->new( retrieve => sub { my $self=ref($_[0]) && ref($_[0]) ne 'HASH' ? shift : ''; my $args=get_args(\@_); return $count++ . '-' . $args->{name} . '-' . ($args->{subname} || ''); }, coords => ['name','subname'], size => 2, expire => 3, ); $self->assert(ref($cache), "Can't create Cache"); my $d1=$cache->get(name => 'd1'); $self->assert($d1 eq '0-d1-', "Got wrong value for d1 (expected '0-d1-', got '$d1')"); my $d2=$cache->get($self, name => 'd2', subname => 's2', foo => 123); $self->assert($d2 eq '1-d2-s2', "Got wrong value for d2 (expected '1-d2-s2', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's3', foo => 123); $self->assert($d2 eq '2-d2-s3', "Got wrong value for d2 (expected '1-d2-s3', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's2', foo => 123); $self->assert($d2 eq '1-d2-s2', "Got wrong value for d2 (expected '1-d2-s2', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's3', foo => 123); $self->assert($d2 eq '2-d2-s3', "Got wrong value for d2 (expected '1-d2-s3', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's2', foo => 123); $self->assert($d2 eq '1-d2-s2', "Got wrong value for d2 (expected '1-d2-s2', got '$d2')"); ## # Checking if it is expired # sleep(4); $d1=$cache->get(name => 'd1', bar => 234); $self->assert($d1 eq '3-d1-', "Got wrong value for d1 (expected '3-d1-', got '$d1')"); for(my $i=0; $i!=100; $i++) { $d2=$cache->get(name => 'd2', subname => $i); } $d1=$cache->get(name => 'd1', bar => 234); $self->assert($d1 eq '3-d1-', "Got wrong value for d1 (expected '3-d1-', got '$d1')"); for(my $i=100; $i!=300; $i++) { $d2=$cache->get(name => 'd2', subname => $i); } ## # At that point it should be thrown out because of size # $d1=$cache->get(name => 'd1', bar => 234); $self->assert($d1 eq '304-d1-', "Got wrong value for d1 (expected '304-d1-', got '$d1')"); ## # Rechecking that after removals the cache still works fine. # $d2=$cache->get($self, name => 'd2', subname => 's2', foo => 123); $self->assert($d2 eq '305-d2-s2', "Got wrong value for d2 (expected '305-d2-s2', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's3', foo => 123); $self->assert($d2 eq '306-d2-s3', "Got wrong value for d2 (expected '306-d2-s3', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's2', foo => 123); $self->assert($d2 eq '305-d2-s2', "Got wrong value for d2 (expected '305-d2-s2', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's3', foo => 123); $self->assert($d2 eq '306-d2-s3', "Got wrong value for d2 (expected '306-d2-s3', got '$d2')"); $d2=$cache->get($self, name => 'd2', subname => 's2', foo => 123); $self->assert($d2 eq '305-d2-s2', "Got wrong value for d2 (expected '305-d2-s2', got '$d2')"); } sub test_size { my $self=shift; my $counter=0; my $cache=XAO::Cache->new( retrieve => sub { my $args=get_args(\@_); return $args->{name} . '-' . $counter++; }, expire => 10, size => 0.04, coords => 'name', ); my @matrix=( aaaa => 'aaaa-0', aaaa => 'aaaa-0', bbbb => 'bbbb-1', aaaa => 'aaaa-0', bbbb => 'bbbb-1', cccc => 'cccc-2', bbbb => 'bbbb-1', dddd => 'dddd-3', aaaa => 'aaaa-0', bbbb => 'bbbb-1', cccc => 'cccc-2', dddd => 'dddd-3', eeee => 'eeee-4', aaaa => 'aaaa-5', bbbb => 'bbbb-6', cccc => 'cccc-7', dddd => 'dddd-8', eeee => 'eeee-9', ); for(my $i=0; $i!=@matrix; $i+=2) { my $expect=$matrix[$i+1]; my $got=$cache->get(name => $matrix[$i]); $self->assert($got eq $expect, "Test ".($i/2)." failed (expected '$expect', got '$got')"); } } sub test_drop { my $self=shift; my $count=0; my $cache=XAO::Cache->new( retrieve => sub { my $self=ref($_[0]) && ref($_[0]) ne 'HASH' ? shift : ''; my $args=get_args(\@_); return $count++ . '-' . $args->{name} . '-' . ($args->{subname} || ''); }, coords => ['name','subname'], size => 2, expire => 3, ); $self->assert(ref($cache), "Can't create Cache"); $cache->get(name => 'd1'); $cache->get(name => 'd2'); $cache->get(name => 'd3'); $cache->get(name => 'd4'); $cache->get(name => 'd5'); my @matrix=( d1 => { d1 => '5-d1-', d2 => '1-d2-', d3 => '2-d3-', d4 => '3-d4-', d5 => '4-d5-', }, d5 => { d1 => '5-d1-', d2 => '1-d2-', d3 => '2-d3-', d4 => '3-d4-', d5 => '6-d5-', }, d3 => { d1 => '5-d1-', d2 => '1-d2-', d3 => '7-d3-', d4 => '3-d4-', d5 => '6-d5-', }, d4 => { }, d2 => { }, d5 => { }, d1 => { }, d3 => { d1 => '8-d1-', d2 => '9-d2-', d3 => '10-d3-', d4 => '11-d4-', d5 => '12-d5-', }, ); for(my $i=0; $i<@matrix; $i+=2) { my $dn=$matrix[$i]; my $expect=$matrix[$i+1]; $cache->drop(name => $dn); foreach my $en (sort keys %$expect) { my $got=$cache->get(name => $en); $self->assert($got eq $expect->{$en}, "Got wrong value after dropping $dn (expect '$expect->{$en}', got '$got')"); } } } 1;