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