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