1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
package CHI::t::Driver::Memory;
{
$CHI::t::Driver::Memory::VERSION = '0.58';
}
use strict;
use warnings;
use CHI::Test;
use CHI::Test::Driver::Role::CheckKeyValidity;
use Test::Warn;
use base qw(CHI::t::Driver);
# Skip multiple process test
sub test_multiple_processes { }
sub new_cache_options {
my $self = shift;
return ( $self->SUPER::new_cache_options(), global => 1 );
}
sub new_cache {
my $self = shift;
my %params = @_;
# If new_cache called with datastore, ignore global flag (otherwise would be an error)
#
if ( $params{datastore} ) {
$params{global} = 0;
}
# Check test key validity on every get and set - only necessary to do for one driver
#
$params{roles} = ['+CHI::Test::Driver::Role::CheckKeyValidity'];
$params{test_object} = $self;
my $cache = CHI->new( $self->new_cache_options(), %params );
return $cache;
}
sub test_short_driver_name : Tests {
my ($self) = @_;
my $cache = $self->{cache};
is( $cache->short_driver_name, 'Memory' );
}
# Warn if global or datastore not passed, but still use global datastore by default
#
sub test_global_or_datastore_required : Tests {
my ( $cache, $cache2 );
warning_like( sub { $cache = CHI->new( driver => 'Memory' ) },
qr/must specify either/ );
warning_like( sub { $cache2 = CHI->new( driver => 'Memory' ) },
qr/must specify either/ );
$cache->set( 'foo', 5 );
is( $cache2->get('foo'), 5, "defaulted to global datastore" );
}
# Make sure two caches don't share datastore
#
sub test_different_datastores : Tests {
my $self = shift;
my $cache1 = CHI->new( driver => 'Memory', datastore => {} );
my $cache2 = CHI->new( driver => 'Memory', datastore => {} );
$self->set_some_keys($cache1);
ok( !$cache2->get_keys() );
}
# Make sure cache is cleared when datastore itself is cleared
#
sub test_clear_datastore : Tests {
my $self = shift;
$self->num_tests( $self->{key_count} * 3 + 6 );
my (@caches);
my %datastore;
$caches[0] =
$self->new_cache( namespace => 'name', datastore => \%datastore );
$caches[1] =
$self->new_cache( namespace => 'other', datastore => \%datastore );
$caches[2] =
$self->new_cache( namespace => 'name', datastore => \%datastore );
$self->set_some_keys( $caches[0] );
$self->set_some_keys( $caches[1] );
%datastore = ();
foreach my $i ( 0 .. 2 ) {
$self->_verify_cache_is_cleared( $caches[$i],
"cache $i after out of scope" );
}
}
sub test_lru_discard : Tests {
my $self = shift;
return 'author testing only' unless ( $ENV{AUTHOR_TESTING} );
my $cache = $self->new_cleared_cache( max_size => 41 );
is( $cache->discard_policy, 'lru' );
my $value_20 = 'x' x 6;
foreach my $key ( map { "key$_" } (qw(1 2 3 4 5 6 5 6 5 3 2)) ) {
$cache->set( $key, $value_20 );
}
cmp_set( [ $cache->get_keys ], [ "key2", "key3" ] );
}
1;
|
